Session JinjaDCI

Theory Auxiliary

(*  Title:      JinjaDCI/Common/Auxiliary.thy

    Author:     David von Oheimb, Tobias Nipkow, Susannah Mansky
    Copyright   1999 TU Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/Auxiliary.thy by David von Oheimb and Tobias Nipkow
*)

chapter ‹ Jinja Source Language \label{cha:j} ›

section ‹ Auxiliary Definitions ›

theory Auxiliary imports Main begin
(* FIXME move and possibly turn into a general simproc *)
lemma nat_add_max_le[simp]:
  "((n::nat) + max i j  m) = (n + i  m  n + j  m)"
 (*<*)by arith(*>*)

lemma Suc_add_max_le[simp]:
  "(Suc(n + max i j)  m) = (Suc(n + i)  m  Suc(n + j)  m)"
(*<*)by arith(*>*)


notation Some  ("(_)")

(*<*)
declare
 option.splits[split]
 Let_def[simp]
 subset_insertI2 [simp]
 Cons_eq_map_conv [iff]
(*>*)


subsection @{text distinct_fst}
 
definition distinct_fst  :: "('a × 'b) list  bool"
where
  "distinct_fst    distinct  map fst"

lemma distinct_fst_Nil [simp]:
  "distinct_fst []"
 (*<*)
by (unfold distinct_fst_def) (simp (no_asm))
(*>*)

lemma distinct_fst_Cons [simp]:
  "distinct_fst ((k,x)#kxs) = (distinct_fst kxs  (y. (k,y)  set kxs))"
(*<*)
by (unfold distinct_fst_def) (auto simp:image_def)
(*>*)

lemma distinct_fst_appendD:
 "distinct_fst(kxs @ kxs')  distinct_fst kxs  distinct_fst kxs'"
(*<*)by(induct kxs, auto)(*>*)

lemma map_of_SomeI:
  " distinct_fst kxs; (k,x)  set kxs   map_of kxs k = Some x"
(*<*)by (induct kxs) (auto simp:fun_upd_apply)(*>*)


subsection ‹ Using @{term list_all2} for relations ›

definition fun_of :: "('a × 'b) set  'a  'b  bool"
where
  "fun_of S  λx y. (x,y)  S"

text ‹ Convenience lemmas ›
(*<*)
declare fun_of_def [simp]
(*>*)
lemma rel_list_all2_Cons [iff]:
  "list_all2 (fun_of S) (x#xs) (y#ys) = 
   ((x,y)  S  list_all2 (fun_of S) xs ys)"
  (*<*)by simp(*>*)

lemma rel_list_all2_Cons1:
  "list_all2 (fun_of S) (x#xs) ys = 
  (z zs. ys = z#zs  (x,z)  S  list_all2 (fun_of S) xs zs)"
  (*<*)by (cases ys) auto(*>*)

lemma rel_list_all2_Cons2:
  "list_all2 (fun_of S) xs (y#ys) = 
  (z zs. xs = z#zs  (z,y)  S  list_all2 (fun_of S) zs ys)"
  (*<*)by (cases xs) auto(*>*)

lemma rel_list_all2_refl:
  "(x. (x,x)  S)  list_all2 (fun_of S) xs xs"
  (*<*)by (simp add: list_all2_refl)(*>*)

lemma rel_list_all2_antisym:
  " (x y. (x,y)  S; (y,x)  T  x = y); 
     list_all2 (fun_of S) xs ys; list_all2 (fun_of T) ys xs   xs = ys"
  (*<*)by (rule list_all2_antisym) auto(*>*)

lemma rel_list_all2_trans: 
  " a b c. (a,b)  R; (b,c)  S  (a,c)  T;
    list_all2 (fun_of R) as bs; list_all2 (fun_of S) bs cs 
   list_all2 (fun_of T) as cs"
  (*<*)by (rule list_all2_trans) auto(*>*)

lemma rel_list_all2_update_cong:
  " i<size xs; list_all2 (fun_of S) xs ys; (x,y)  S  
   list_all2 (fun_of S) (xs[i:=x]) (ys[i:=y])"
  (*<*)by (simp add: list_all2_update_cong)(*>*)

lemma rel_list_all2_nthD:
  " list_all2 (fun_of S) xs ys; p < size xs   (xs!p,ys!p)  S"
  (*<*)by (drule list_all2_nthD) auto(*>*)

lemma rel_list_all2I:
  " length a = length b; n. n < length a  (a!n,b!n)  S   list_all2 (fun_of S) a b"
  (*<*)by (erule list_all2_all_nthI) simp(*>*)

(*<*)declare fun_of_def [simp del](*>*)

subsection ‹ Auxiliary properties of @{text "map_of"} function ›

lemma map_of_set_pcs_notin: "C  (λt. snd (fst t)) ` set FDTs  map_of FDTs (F, C) = None"
(*<*)by (metis image_eqI image_image map_of_eq_None_iff snd_conv)(*>*)

lemma map_of_insertmap_SomeD':
  "map_of fs F = Some y  map_of (map (λ(F, y). (F, D, y)) fs) F = Some(D,y)"
(*<*)by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)(*>*)

lemma map_of_reinsert_neq_None:
  "Ca  D  map_of (map (λ(F, y). ((F, Ca), y)) fs) (F, D) = None"
(*<*)by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)(*>*)

lemma map_of_remap_insertmap:
  "map_of (map ((λ((F, D), b, T). (F, D, b, T))  (λ(F, y). ((F, D), y))) fs)
    = map_of (map (λ(F, y). (F, D, y)) fs)"
(*<*)by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)(*>*)


lemma map_of_reinsert_SomeD:
  "map_of (map (λ(F, y). ((F, D), y)) fs) (F, D) = Some T  map_of fs F = Some T"
(*<*)by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)(*>*)

lemma map_of_filtered_SomeD:
"map_of fs (F,D) = Some (a, T)  Q ((F,D),a,T) 
       map_of (map (λ((F,D), b, T). ((F,D), P T)) (filter Q fs))
        (F,D) = Some (P T)"
(*<*)by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)(*>*)


lemma map_of_remove_filtered_SomeD:
"map_of fs (F,C) = Some (a, T)  Q ((F,C),a,T) 
       map_of (map (λ((F,D), b, T). (F, P T)) [((F, D), b, T)fs . Q ((F, D), b, T)  D = C])
        F = Some (P T)"
(*<*)by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)(*>*)


lemma map_of_Some_None_split:
assumes "t = map (λ(F, y). ((F, C), y)) fs @ t'" "map_of t' (F, C) = None" "map_of t (F, C) = Some y"
shows "map_of (map (λ((F, D), b, T). (F, D, b, T)) t) F = Some (C, y)"
(*<*)
proof -
  have "map_of (map (λ(F, y). ((F, C), y)) fs) (F, C) = Some y" using assms by auto
  then have "p. map_of fs F = Some p  Some y  Some p"
    by (metis map_of_reinsert_SomeD)
  then have "f b p pa. ((f ++ map_of (map (λ(a, p). (a, b::'b, p)) fs)) F = Some p  Some (b, pa)  Some p)
      Some y  Some pa"
    by (metis (no_types) map_add_find_right map_of_insertmap_SomeD')
  then have "(map_of (map (λ((a, b), c, d). (a, b, c, d)) t')
                     ++ map_of (map (λ(a, p). (a, C, p)) fs)) F = Some (C, y)"
    by blast
  then have "(map_of (map (λ((a, b), c, d). (a, b, c, d)) t')
      ++ map_of (map ((λ((a, b), c, d). (a, b, c, d))  (λ(a, y). ((a, C), y))) fs)) F = Some (C, y)"
    by (simp add: map_of_remap_insertmap)
  then show ?thesis using assms by auto
qed
(*>*)

end

Theory Type

(*  Title:      JinjaDCI/Common/Type.thy

    Author:     David von Oheimb, Tobias Nipkow, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/Type.thy by David von Oheimb and Tobias Nipkow
*)

section ‹ Jinja types ›        

theory Type imports Auxiliary begin

type_synonym cname = string ― ‹class names›
type_synonym mname = string ― ‹method name›
type_synonym vname = string ― ‹names for local/field variables›

definition Object :: cname
where
  "Object  ''Object''"

definition this :: vname
where
  "this  ''this''"

definition clinit :: "string" where "clinit = ''<clinit>''"
definition init :: "string" where "init = ''<init>''"

definition start_m :: "string" where "start_m = ''<start>''"
definition Start :: "string" where "Start = ''<Start>''"

lemma start_m_neq_clinit [simp]: "start_m  clinit" by(simp add: start_m_def clinit_def)
lemma Object_neq_Start [simp]: "Object  Start" by(simp add: Object_def Start_def)
lemma Start_neq_Object [simp]: "Start  Object" by(simp add: Object_def Start_def)

― ‹field/method static flag›

datatype staticb = Static | NonStatic

― ‹types›
datatype ty
  = Void          ― ‹type of statements›
  | Boolean
  | Integer
  | NT            ― ‹null type›
  | Class cname   ― ‹class type›

definition is_refT :: "ty  bool"
where
  "is_refT T    T = NT  (C. T = Class C)"

lemma [iff]: "is_refT NT"
(*<*)by(simp add:is_refT_def)(*>*)

lemma [iff]: "is_refT(Class C)"
(*<*)by(simp add:is_refT_def)(*>*)

lemma refTE:
  "is_refT T; T = NT  P; C. T = Class C  P   P"
(*<*)by (auto simp add: is_refT_def)(*>*)

lemma not_refTE:
  " ¬is_refT T; T = Void  T = Boolean  T = Integer  P   P"
(*<*)by (cases T, auto simp add: is_refT_def)(*>*)

end

Theory Decl

(*  Title:      JinjaDCI/Common/Decl.thy

    Author:     David von Oheimb, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/Decl.thy by David von Oheimb
*)

section ‹ Class Declarations and Programs ›

theory Decl imports Type begin

type_synonym 
  fdecl    = "vname × staticb × ty"        ― ‹field declaration›
type_synonym
  'm mdecl = "mname × staticb × ty list × ty × 'm"     ― ‹method = name, static flag, arg.\ types, return type, body›
type_synonym
  'm "class" = "cname × fdecl list × 'm mdecl list"       ― ‹class = superclass, fields, methods›
type_synonym
  'm cdecl = "cname × 'm class"  ― ‹class declaration›
type_synonym
  'm prog  = "'m cdecl list"     ― ‹program›

(* replaced all fname, mname, cname in below with `char list' so that
 pretty printing works   -SM *)
(*<*)
translations
  (type) "fdecl"   <= (type) "char list × staticb × ty"
  (type) "'c mdecl" <= (type) "char list × staticb × ty list × ty × 'c"
  (type) "'c class" <= (type) "char list × fdecl list × ('c mdecl) list"
  (type) "'c cdecl" <= (type) "char list × ('c class)"
  (type) "'c prog" <= (type) "('c cdecl) list"
(*>*)

definition "class" :: "'m prog  cname  'm class"
where
  "class    map_of"

(* Not difficult to prove, but useful for directing particular sequences of equality -SM *)
lemma class_cons: " C  fst x   class (x # P) C = class P C"
 by (simp add: class_def)

definition is_class :: "'m prog  cname  bool"
where
  "is_class P C    class P C  None"

lemma finite_is_class: "finite {C. is_class P C}"
(*<*)
proof -
  have "{C. is_class P C} = dom (map_of P)"
   by (simp add: is_class_def class_def dom_def)
  thus ?thesis by (simp add: finite_dom_map_of)
qed
(*>*)

definition is_type :: "'m prog  ty  bool"
where
  "is_type P T  
  (case T of Void  True | Boolean  True | Integer  True | NT  True
   | Class C  is_class P C)"

lemma is_type_simps [simp]:
  "is_type P Void  is_type P Boolean  is_type P Integer 
  is_type P NT  is_type P (Class C) = is_class P C"
(*<*)by(simp add:is_type_def)(*>*)


abbreviation
  "types P == Collect (is_type P)"

lemma class_exists_equiv:
 "(x. fst x = cn  x  set P) = (class P cn  None)"
proof(rule iffI)
 assume "x. fst x = cn  x  set P" then show "class P cn  None"
   by (metis class_def image_eqI map_of_eq_None_iff)
next
 assume "class P cn  None" then show "x. fst x = cn  x  set P"
   by (metis class_def fst_conv map_of_SomeD option.exhaust)
qed

lemma class_exists_equiv2:
 "(x. fst x = cn  x  set (P1 @ P2)) = (class P1 cn  None  class P2 cn  None)"
by (simp only: class_exists_equiv [where P = "P1@P2"], simp add: class_def)

end

Theory TypeRel

(*  Title:      JinjaDCI/Common/TypeRel.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/TypeRel.thy by Tobias Nipkow
*)

section ‹ Relations between Jinja Types ›

theory TypeRel imports 
  "HOL-Library.Transitive_Closure_Table"
  Decl
begin

subsection ‹ The subclass relations ›

inductive_set
  subcls1 :: "'m prog  (cname × cname) set"
  and subcls1' :: "'m prog  [cname, cname]  bool" ("_  _ 1 _" [71,71,71] 70)
  for P :: "'m prog"
where
  "P  C  1 D  (C,D)  subcls1 P"
| subcls1I: "class P C = Some (D,rest); C  Object  P  C 1 D"

abbreviation
  subcls  :: "'m prog  [cname, cname]  bool" ("_  _ * _"  [71,71,71] 70)
  where "P  C  *  D  (C,D)  (subcls1 P)*"

lemma subcls1D: "P  C 1 D  C  Object  (fs ms. class P C = Some (D,fs,ms))"
(*<*)by(erule subcls1.induct)(fastforce simp add:is_class_def)(*>*)

lemma [iff]: "¬ P  Object 1 C"
(*<*)by(fastforce dest:subcls1D)(*>*)

lemma [iff]: "(P  Object * C) = (C = Object)"
(*<*)
proof(rule iffI)
 assume "P  Object * C" then show "C = Object"
  by(auto elim: converse_rtranclE)
qed simp
(*>*)

lemma subcls1_def2:
  "subcls1 P =
     (SIGMA C:{C. is_class P C}. {D. CObject  fst (the (class P C))=D})"
(*<*)
  by (fastforce simp:is_class_def dest: subcls1D elim: subcls1I)
(*>*)

lemma finite_subcls1: "finite (subcls1 P)"
(*<*)
proof -
  let ?SIG = "SIGMA C:{C. is_class P C}. {D. fst (the (class P C)) = D  C  Object}"
  have "subcls1 P = ?SIG" by(simp add: subcls1_def2)
  also have "finite ?SIG"
  proof(rule finite_SigmaI [OF finite_is_class])
    fix C assume C_in: "C  {C. is_class P C}"
    then show "finite {D. fst (the (class P C)) = D  C  Object}"
     by(rule_tac finite_subset[where B = "{fst (the (class P C))}"]) auto
  qed
  ultimately show ?thesis by simp
qed
(*>*)

primrec supercls_lst :: "'m prog  cname list  bool" where
"supercls_lst P (C#Cs) = ((C'  set Cs. P  C' * C)  supercls_lst P Cs)" |
"supercls_lst P [] = True"

lemma supercls_lst_app:
 " supercls_lst P (C#Cs); P  C * C'   supercls_lst P (C'#C#Cs)"
 by auto

subsection‹ The subtype relations ›

inductive
  widen   :: "'m prog  ty  ty  bool" ("_  _  _"   [71,71,71] 70)
  for P :: "'m prog"
where
  widen_refl[iff]: "P  T  T"
| widen_subcls: "P  C * D    P  Class C  Class D"
| widen_null[iff]: "P  NT  Class C"

abbreviation
  widens :: "'m prog  ty list  ty list  bool"
    ("_  _ [≤] _" [71,71,71] 70) where
  "widens P Ts Ts'  list_all2 (widen P) Ts Ts'"

lemma [iff]: "(P  T  Void) = (T = Void)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P  T  Boolean) = (T = Boolean)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P  T  Integer) = (T = Integer)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P  Void  T) = (T = Void)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P  Boolean  T) = (T = Boolean)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P  Integer  T) = (T = Integer)"
(*<*)by (auto elim: widen.cases)(*>*)


lemma Class_widen: "P  Class C  T    D. T = Class D"
(*<*)
by (ind_cases "P  Class C  T") auto
(*>*)

lemma [iff]: "(P  T  NT) = (T = NT)"
(*<*)
by(cases T) (auto dest:Class_widen)
(*>*)

lemma Class_widen_Class [iff]: "(P  Class C  Class D) = (P  C * D)"
(*<*)
proof(rule iffI)
  show "P  Class C  Class D  P  C * D"
  proof(ind_cases "P  Class C  Class D") qed(auto)
qed(auto elim: widen_subcls)
(*>*)

lemma widen_Class: "(P  T  Class C) = (T = NT  (D. T = Class D  P  D * C))"
(*<*)by(induct T, auto)(*>*)


lemma widen_trans[trans]: "P  S  U; P  U  T  P  S  T"
(*<*)
proof -
  assume "PS  U" thus "T. P  U  T  P  S  T"
  proof induct
    case (widen_refl T T') thus "P  T  T'" .
  next
    case (widen_subcls C D T)
    then obtain E where "T = Class E" by (blast dest: Class_widen)
    with widen_subcls show "P  Class C  T" by (auto elim: rtrancl_trans)
  next
    case (widen_null C RT)
    then obtain D where "RT = Class D" by (blast dest: Class_widen)
    thus "P  NT  RT" by auto
  qed
qed
(*>*)

lemma widens_trans [trans]: "P  Ss [≤] Ts; P  Ts [≤] Us  P  Ss [≤] Us"
(*<*)by (rule list_all2_trans, rule widen_trans)(*>*)


(*<*)
lemmas widens_refl [iff] = list_all2_refl [of "widen P", OF widen_refl] for P
lemmas widens_Cons [iff] = list_all2_Cons1 [of "widen P"] for P
(*>*)


subsection‹ Method lookup ›

inductive
  Methods :: "['m prog, cname, mname  (staticb × ty list × ty × 'm) × cname]  bool"
                    ("_  _ sees'_methods _" [51,51,51] 50)
  for P :: "'m prog"
where
  sees_methods_Object:
 " class P Object = Some(D,fs,ms); Mm = map_option (λm. (m,Object))  map_of ms 
   P  Object sees_methods Mm"
| sees_methods_rec:
 " class P C = Some(D,fs,ms); C  Object; P  D sees_methods Mm;
    Mm' = Mm ++ (map_option (λm. (m,C))  map_of ms) 
   P  C sees_methods Mm'"

lemma sees_methods_fun:
assumes 1: "P  C sees_methods Mm"
shows "Mm'. P  C sees_methods Mm'  Mm' = Mm"
 (*<*)
using 1
proof induct
  case (sees_methods_rec C D fs ms Dres Cres Cres')
  have "class": "class P C = Some (D, fs, ms)"
   and notObj: "C  Object" and Dmethods: "P  D sees_methods Dres"
   and IH: "Dres'. P  D sees_methods Dres'  Dres' = Dres"
   and Cres: "Cres = Dres ++ (map_option (λm. (m,C))  map_of ms)"
   and Cmethods': "P  C sees_methods Cres'" by fact+
  from Cmethods' notObj "class" obtain Dres'
    where Dmethods': "P  D sees_methods Dres'"
     and Cres': "Cres' = Dres' ++ (map_option (λm. (m,C))  map_of ms)"
    by(auto elim: Methods.cases)
  from Cres Cres' IH[OF Dmethods'] show "Cres' = Cres" by simp
next
  case sees_methods_Object thus ?case by(auto elim: Methods.cases)
qed
(*>*)

lemma visible_methods_exist:
  "P  C sees_methods Mm  Mm M = Some(m,D) 
   (D' fs ms. class P D = Some(D',fs,ms)  map_of ms M = Some m)"
 (*<*)by(induct rule:Methods.induct) auto(*>*)

lemma sees_methods_decl_above:
assumes Csees: "P  C sees_methods Mm"
shows "Mm M = Some(m,D)  P  C * D"
 (*<*)
using Csees
proof induct
next
  case sees_methods_Object thus ?case by auto
next
  case sees_methods_rec thus ?case
    by(fastforce simp:map_option_case split:option.splits
                elim:converse_rtrancl_into_rtrancl[OF subcls1I])
qed
(*>*)

lemma sees_methods_idemp:
assumes Cmethods: "P  C sees_methods Mm"
shows "m D. Mm M = Some(m,D) 
              Mm'. (P  D sees_methods Mm')  Mm' M = Some(m,D)"
(*<*)
using Cmethods
proof induct
  case sees_methods_Object thus ?case
    by(fastforce dest: Methods.sees_methods_Object)
next
  case sees_methods_rec thus ?case
    by(fastforce split:option.splits dest: Methods.sees_methods_rec)
qed
(*>*)

(*FIXME something wrong with induct: need to attache [consumes 1]
directly to proof of thm, declare does not work. *)

lemma sees_methods_decl_mono:
assumes sub: "P  C' * C"
shows "P  C sees_methods Mm 
       Mm' Mm2. P  C' sees_methods Mm'  Mm' = Mm ++ Mm2 
                 (M m D. Mm2 M = Some(m,D)  P  D * C)"
(*<*)
      (is "_  Mm' Mm2. ?Q C' C Mm' Mm2")
using sub
proof (induct rule:converse_rtrancl_induct)
  assume "P  C sees_methods Mm"
  hence "?Q C C Mm Map.empty" by simp
  thus "Mm' Mm2. ?Q C C Mm' Mm2" by blast
next
  fix C'' C'
  assume sub1: "P  C'' 1 C'" and sub: "P  C' * C"
  and IH: "P  C sees_methods Mm 
           Mm' Mm2. P  C' sees_methods Mm' 
                Mm' = Mm ++ Mm2  (M m D. Mm2 M = Some(m,D)  P  D * C)"
  and Csees: "P  C sees_methods Mm"
  from IH[OF Csees] obtain Mm' Mm2 where C'sees: "P  C' sees_methods Mm'"
    and Mm': "Mm' = Mm ++ Mm2"
    and subC:"M m D. Mm2 M = Some(m,D)  P  D * C" by blast
  obtain fs ms where "class": "class P C'' = Some(C',fs,ms)" "C''  Object"
    using subcls1D[OF sub1] by blast
  let ?Mm3 = "map_option (λm. (m,C''))  map_of ms"
  have "P  C'' sees_methods (Mm ++ Mm2) ++ ?Mm3"
    using sees_methods_rec[OF "class" C'sees refl] Mm' by simp
  hence "?Q C'' C ((Mm ++ Mm2) ++ ?Mm3) (Mm2++?Mm3)"
    using converse_rtrancl_into_rtrancl[OF sub1 sub]
    by simp (simp add:map_add_def subC split:option.split)
  thus "Mm' Mm2. ?Q C'' C Mm' Mm2" by blast
qed
(*>*)

lemma sees_methods_is_class_Object:
 "P  D sees_methods Mm  is_class P Object"
 by(induct rule: Methods.induct; simp add: is_class_def)

lemma sees_methods_sub_Obj: "P  C sees_methods Mm  P  C * Object"
proof(induct rule: Methods.induct)
  case (sees_methods_rec C D fs ms Mm Mm') show ?case
  using subcls1I[OF sees_methods_rec.hyps(1,2)] sees_methods_rec.hyps(4)
   by(rule converse_rtrancl_into_rtrancl)
qed(simp)


definition Method :: "'m prog  cname  mname  staticb  ty list  ty  'm  cname  bool"
            ("_  _ sees _, _ :  __ = _ in _" [51,51,51,51,51,51,51,51] 50)
where
  "P  C sees M, b: TsT = m in D  
  Mm. P  C sees_methods Mm  Mm M = Some((b,Ts,T,m),D)"

definition has_method :: "'m prog  cname  mname  staticb  bool"
            ("_  _ has _, _" [51,0,0,51] 50)
where
  "P  C has M, b  Ts T m D. P  C sees M,b:TsT = m in D"

lemma sees_method_fun:
  "P  C sees M,b:TST = m in D; P  C sees M,b':TS'T' = m' in D' 
    b = b'  TS' = TS  T' = T  m' = m  D' = D"
 (*<*)by(fastforce dest: sees_methods_fun simp:Method_def)(*>*)

lemma sees_method_decl_above:
  "P  C sees M,b:TsT = m in D  P  C * D"
 (*<*)by(clarsimp simp:Method_def sees_methods_decl_above)(*>*)

lemma visible_method_exists:
  "P  C sees M,b:TsT = m in D 
  D' fs ms. class P D = Some(D',fs,ms)  map_of ms M = Some(b,Ts,T,m)"
(*<*)by(fastforce simp:Method_def dest!: visible_methods_exist)(*>*)


lemma sees_method_idemp:
  "P  C sees M,b:TsT=m in D  P  D sees M,b:TsT=m in D"
 (*<*)by(fastforce simp: Method_def intro:sees_methods_idemp)(*>*)

lemma sees_method_decl_mono:
assumes sub: "P  C' * C" and
        C_sees: "P  C sees M,b:TsT=m in D" and
        C'_sees: "P  C' sees M,b':Ts'T'=m' in D'"
shows   "P  D' * D"
 (*<*)
proof -
  obtain Ms where Ms: "P  C sees_methods Ms"
    using C_sees by(auto simp: Method_def)
  obtain Ms' Ms2 where Ms': "P  C' sees_methods Ms'" and
     Ms'_def: "Ms' = Ms ++ Ms2" and
     Ms2_imp: "(M m D. Ms2 M = (m, D)  P  D * C)"
    using sees_methods_decl_mono[OF sub Ms] by clarsimp
  have "(Ms ++ Ms2) M = ((b', Ts', T', m'), D')"
    using C'_sees sees_methods_fun[OF Ms'] Ms'_def by(clarsimp simp: Method_def)
  then have "Ms2 M = ((b', Ts', T', m'), D') 
             Ms2 M = None  b = b'  Ts = Ts'  T = T'  m = m'  D = D'"
    using C_sees sees_methods_fun[OF Ms] by(clarsimp simp: Method_def)
  also have "Ms2 M = ((b', Ts', T', m'), D')  P  D' * C"
    using Ms2_imp by simp
  ultimately show ?thesis using sub sees_method_decl_above[OF C_sees] by auto
qed
(*>*)

lemma sees_methods_is_class: "P  C sees_methods Mm  is_class P C"
(*<*)by (auto simp add: is_class_def elim: Methods.induct)(*>*)

lemma sees_method_is_class:
  " P  C sees M,b:TsT=m in D   is_class P C"
(*<*)by (auto simp add: is_class_def Method_def dest: sees_methods_is_class)(*>*)

lemma sees_method_is_class':
  " P  C sees M,b:TsT=m in D   is_class P D"
(*<*)by(drule sees_method_idemp, rule sees_method_is_class, assumption)(*>*)

lemma sees_method_sub_Obj: "P  C sees M,b:  TsT = m in D  P  C * Object"
 by(auto simp: Method_def sees_methods_sub_Obj)

subsection‹ Field lookup ›

inductive
  Fields :: "['m prog, cname, ((vname × cname) × staticb × ty) list]  bool"
                  ("_  _ has'_fields _" [51,51,51] 50)
  for P :: "'m prog"
where
  has_fields_rec:
  " class P C = Some(D,fs,ms); C  Object; P  D has_fields FDTs;
     FDTs' = map (λ(F,b,T). ((F,C),b,T)) fs @ FDTs 
    P  C has_fields FDTs'"
| has_fields_Object:
  " class P Object = Some(D,fs,ms); FDTs = map (λ(F,b,T). ((F,Object),b,T)) fs 
    P  Object has_fields FDTs"

lemma has_fields_is_class:
 "P  C has_fields FDTs  is_class P C"
(*<*)by (auto simp add: is_class_def elim: Fields.induct)(*>*)

lemma has_fields_fun:
assumes 1: "P  C has_fields FDTs"
shows "FDTs'. P  C has_fields FDTs'  FDTs' = FDTs"
 (*<*)
using 1
proof induct
  case (has_fields_rec C D fs ms Dres Cres Cres')
  have "class": "class P C = Some (D, fs, ms)"
   and notObj: "C  Object" and DFields: "P  D has_fields Dres"
   and IH: "Dres'. P  D has_fields Dres'  Dres' = Dres"
   and Cres: "Cres = map (λ(F,b,T). ((F,C),b,T)) fs @ Dres"
   and CFields': "P  C has_fields Cres'" by fact+
  from CFields' notObj "class" obtain Dres'
    where DFields': "P  D has_fields Dres'"
     and Cres': "Cres' = map (λ(F,b,T). ((F,C),b,T)) fs @ Dres'"
    by(auto elim: Fields.cases)
  from Cres Cres' IH[OF DFields'] show "Cres' = Cres" by simp
next
  case has_fields_Object thus ?case by(auto elim: Fields.cases)
qed
(*>*)

lemma all_fields_in_has_fields:
assumes sub: "P  C has_fields FDTs"
shows " P  C * D; class P D = Some(D',fs,ms); (F,b,T)  set fs 
        ((F,D),b,T)  set FDTs"
(*<*)
using sub proof(induct)
  case (has_fields_rec C D' fs ms FDTs FDTs')
  then have C_D: "P  C * D" by simp
  then show ?case proof(rule converse_rtranclE)
    assume "C = D"
    then show ?case using has_fields_rec by force
  next
    fix y assume sub1: "P  C 1 y" and sub2: "P  y * D"
    then show ?case using has_fields_rec subcls1D[OF sub1] by simp
  qed
next
  case (has_fields_Object D fs ms FDTs)
  then show ?case by force
qed
(*>*)

lemma has_fields_decl_above:
assumes fields: "P  C has_fields FDTs"
shows "((F,D),b,T)  set FDTs  P  C * D"
(*<*)
using fields proof(induct)
  case (has_fields_rec C D' fs ms FDTs FDTs')
  then have "((F, D), b, T)  (λx. case x of (F, x)  ((F, C), x)) ` set fs 
    ((F, D), b, T)  set FDTs" by clarsimp
  then show ?case proof(rule disjE)
    assume "((F, D), b, T)  (λx. case x of (F, x)  ((F, C), x)) ` set fs"
    then show ?case using has_fields_rec by clarsimp
  next
    assume "((F, D), b, T)  set FDTs"
    then show ?case using has_fields_rec
     by(blast dest:subcls1I converse_rtrancl_into_rtrancl)
  qed
next
  case (has_fields_Object D fs ms FDTs)
  then show ?case by fastforce
qed
(*>*)


lemma subcls_notin_has_fields:
assumes fields: "P  C has_fields FDTs"
shows "((F,D),b,T)  set FDTs  (D,C)  (subcls1 P)+"
(*<*)
using fields proof(induct)
  case (has_fields_rec C D' fs ms FDTs FDTs')
  then have "((F, D), b, T)  (λx. case x of (F, x)  ((F, C), x)) ` set fs
                ((F, D), b, T)  set FDTs" by clarsimp
  then show ?case proof(rule disjE)
    assume "((F, D), b, T)  (λx. case x of (F, x)  ((F, C), x)) ` set fs"
    then have CD[simp]: "C = D" and fs: "(F, b, T)  set fs" by clarsimp+
    then have "(D, D)  (subcls1 P)+  False" proof -
      assume DD: "(D, D)  (subcls1 P)+"
      obtain z where z1: "P  D 1 z" and z_s: "P  z * D"
        using tranclD[OF DD] by clarsimp
      have [simp]: "z = D'" using subcls1D[OF z1] has_fields_rec.hyps(1) by clarsimp
      then have "((F, D), b, T)  set FDTs"
        using z_s all_fields_in_has_fields[OF has_fields_rec.hyps(3) _ has_fields_rec.hyps(1) fs]
         by simp
      then have "(D, z)  (subcls1 P)+" using has_fields_rec.hyps(4) by simp
      then show False using z1 by auto
    qed
    then show ?case by clarsimp
  next
    assume "((F, D), b, T)  set FDTs"
    then show ?case using has_fields_rec by(blast dest:subcls1I trancl_into_trancl)
  qed
next
  case (has_fields_Object D fs ms FDTs)
  then show ?case by(fastforce dest: tranclD)
qed
(*>*)

lemma subcls_notin_has_fields2:
assumes fields: "P  C has_fields FDTs"
shows " C  Object; P  C 1 D   (D,C)  (subcls1 P)*"
using fields proof(induct arbitrary: D)
  case has_fields_rec
  have "C C' P. (C, C')  subcls1 P  C  Object  (fs ms. class P C = (C', fs, ms))"
    using subcls1D by blast
  then have "(D, D)  (subcls1 P)+"
    by (metis (no_types) Pair_inject has_fields_rec.hyps(1) has_fields_rec.hyps(4)
     has_fields_rec.prems(2) option.inject tranclD)
  then show ?case
    by (meson has_fields_rec.prems(2) rtrancl_into_trancl1)
qed(fastforce dest: tranclD)

lemma has_fields_mono_lem:
assumes sub: "P  D * C"
shows "P  C has_fields FDTs
          pre. P  D has_fields pre@FDTs  dom(map_of pre)  dom(map_of FDTs) = {}"
(*<*)
using sub proof(induct rule:converse_rtrancl_induct)
  case base
  then show ?case by(rule_tac x = "[]" in exI) simp
next
  case (step D' D)
  then obtain pre where D_flds: "P  D has_fields pre @ FDTs" and
    dom: "dom (map_of pre)  dom (map_of FDTs) = {}" by clarsimp
  have "(D',C)  (subcls1 P)^+" by (rule rtrancl_into_trancl2[OF step.hyps(1,2)])
  obtain fs ms where D'_cls: "class P D' = (D, fs, ms)" "D'  Object"
    using subcls1D[OF step.hyps(1)] by clarsimp+
  have "P  D' has_fields map (λ(F, T). ((F, D'), T)) fs @ pre @ FDTs"
    using has_fields_rec[OF D'_cls D_flds] by simp
  also have "dom (map_of (map (λ(F, T). ((F, D'), T)) fs @ pre))
                  dom (map_of FDTs) = {}"
    using dom subcls_notin_has_fields[OF D_flds, where D=D'] step.hyps(1)
      by(auto simp:dom_map_of_conv_image_fst) fast
  ultimately show ?case
    by(rule_tac x = "map (λ(F,b,T). ((F,D'),b,T)) fs @ pre" in exI) simp
qed
(*>*)

lemma has_fields_declaring_classes:
shows "P  C has_fields FDTs
  pre FDTs'. FDTs = pre@FDTs'
          (C  Object  (D fs ms. class P C = (D,fs,ms)  P  D has_fields FDTs'))
              set(map (λt. snd(fst t)) pre)  {C}
                 set(map (λt. snd(fst t)) FDTs')  {C'. C'  C  P  C * C'}"
proof(induct rule:Fields.induct)
  case (has_fields_rec C D fs ms FDTs FDTs')
  have sup1: "P  C 1 D" using has_fields_rec.hyps(1,2) by (simp add: subcls1.subcls1I)
  have "P  C has_fields FDTs'"
    using Fields.has_fields_rec[OF has_fields_rec.hyps(1-3)] has_fields_rec by auto
  then have nsup: "(D, C)  (subcls1 P)*" using subcls_notin_has_fields2 sup1 by auto
  show ?case using has_fields_rec sup1 nsup
    by(rule_tac x = "map (λ(F, y). ((F, C), y)) fs" in exI, clarsimp) auto
next
  case has_fields_Object then show ?case by fastforce
qed

lemma has_fields_mono_lem2:
assumes hf: "P  C has_fields FDTs"
 and cls: "class P C = Some(D,fs,ms)" and map_of: "map_of FDTs (F,C) = (b,T)"
shows "FDTs'. FDTs = (map (λ(F,b,T). ((F,C),b,T)) fs) @ FDTs'  map_of FDTs' (F,C) = None"
using assms
proof(cases "C = Object")
  case False
  let ?pre = "map (λ(F,b,T). ((F,C),b,T)) fs"
  have sub: "P  C * D" using cls False by (simp add: r_into_rtrancl subcls1.subcls1I)
  obtain FDTs' where fdts': "P  D has_fields FDTs'" "FDTs = ?pre @ FDTs'"
    using False assms(1,2) Fields.simps[of P C FDTs] by clarsimp
  then have int: "dom (map_of ?pre)  dom (map_of FDTs') = {}"
    using has_fields_mono_lem[OF sub, of FDTs'] has_fields_fun[OF hf] by fastforce
  have "C  (λt. snd (fst t)) ` set FDTs'"
    using has_fields_declaring_classes[OF hf] cls False
          has_fields_fun[OF fdts'(1)] fdts'(2)
      by clarify auto
  then have "map_of FDTs' (F,C) = None" by(rule map_of_set_pcs_notin)
  then show ?thesis using fdts' int by simp
qed(auto dest: has_fields_Object has_fields_fun)


lemma has_fields_is_class_Object:
 "P  D has_fields FDTs  is_class P Object"
 by(induct rule: Fields.induct; simp add: is_class_def)

lemma Object_fields:
 " P  Object has_fields FDTs; C  Object   map_of FDTs (F,C) = None"
 by(drule Fields.cases, auto simp: map_of_reinsert_neq_None)


definition has_field :: "'m prog  cname  vname  staticb  ty  cname  bool"
                   ("_  _ has _,_:_ in _" [51,51,51,51,51,51] 50)
where
  "P  C has F,b:T in D  
  FDTs. P  C has_fields FDTs  map_of FDTs (F,D) = Some (b,T)"


lemma has_field_mono:
assumes has: " P  C has F,b:T in D" and sub: "P  C' * C"
shows "P  C' has F,b:T in D"
(*<*)
proof -
  obtain FDTs where FDTs:"P  C has_fields FDTs" and "map_of FDTs (F, D) = (b, T)"
    using has by(clarsimp simp: has_field_def)
  also obtain pre where "P  C' has_fields pre @ FDTs"
     and "dom (map_of pre)  dom (map_of FDTs) = {}"
    using has_fields_mono_lem[OF sub FDTs] by clarify
  ultimately show ?thesis by(fastforce simp: has_field_def map_add_def split:option.splits)
qed
(*>*)

lemma has_field_fun:
  "P  C has F,b:T in D; P  C has F,b':T' in D  b = b'  T' = T"
(*<*)by(fastforce simp:has_field_def dest:has_fields_fun)(*>*)


lemma has_field_idemp:
assumes has: "P  C has F,b:T in D"
shows "P  D has F,b:T in D"
(*<*)
proof -
  obtain FDTs where C_flds: "P  C has_fields FDTs"
     and FDTs: "map_of FDTs (F, D) = (b, T)" (is "?FDTs")
    using has by(clarsimp simp: has_field_def)
  have map: "C' fs. map_of (map (λ(F, y). ((F, C'), y)) fs) (F, D) = (b, T)  D = C'"
    by(frule map_of_SomeD) clarsimp
  have "?FDTs  P  D has F,b:T in D"
  using C_flds proof induct
    case NObj: (has_fields_rec C' D' fs ms FDTs FDTs')
    then show ?case using map by (fastforce intro: has_fields_rec simp: has_field_def)
  next
    case Obj: (has_fields_Object D fs ms FDTs)
    then show ?case using map by(fastforce intro: has_fields_Object simp: has_field_def)
  qed
  then show ?thesis using FDTs by(rule_tac mp)
qed
(*>*)

lemma visible_fields_exist:
assumes fields: "P  C has_fields FDTs" and
        FDTs:   "map_of FDTs (F,D) = Some (b, T)"
shows "D' fs ms. class P D = Some(D',fs,ms)  map_of fs F = Some(b,T)"
proof -
  have "map_of FDTs (F,D) = Some (b, T) 
   (D' fs ms. class P D = Some(D',fs,ms)  map_of fs F = Some(b,T))"
  using fields proof induct
    case (has_fields_rec C' D' fs ms FDTs')
    with assms map_of_reinsert_SomeD map_of_reinsert_neq_None[where D=D and F=F and fs=fs]
    show ?case proof(cases "C' = D") qed auto
  next
    case (has_fields_Object D' fs ms FDTs)
    with assms map_of_reinsert_SomeD map_of_reinsert_neq_None[where D=D and F=F and fs=fs]
    show ?case proof(cases "Object = D") qed auto
  qed
  then show ?thesis using FDTs by simp
qed

lemma map_of_remap_SomeD:
  "map_of (map (λ((k,k'),x). (k,(k',x))) t) k = Some (k',x)  map_of t (k, k') = Some x"
(*<*)by (induct t) (auto simp:fun_upd_apply split: if_split_asm)(*>*)

lemma map_of_remap_SomeD2:
  "map_of (map (λ((k,k'),x,x'). (k,(k',x,x'))) t) k = Some (k',x,x')  map_of t (k, k') = Some (x, x')"
(*<*)by (induct t) (auto simp:fun_upd_apply split: if_split_asm)(*>*)

lemma has_field_decl_above:
  "P  C has F,b:T in D  P  C * D"
(*<*)
by(auto simp: has_field_def
        intro: has_fields_decl_above map_of_SomeD map_of_remap_SomeD2)
(*>*)

definition sees_field :: "'m prog  cname  vname  staticb  ty  cname  bool"
                  ("_  _ sees _,_:_ in _" [51,51,51,51,51,51] 50)
where
  "P  C sees F,b:T in D 
  FDTs. P  C has_fields FDTs 
            map_of (map (λ((F,D),b,T). (F,(D,b,T))) FDTs) F = Some(D,b,T)"

lemma has_visible_field:
  "P  C sees F,b:T in D  P  C has F,b:T in D"
(*<*)by(auto simp add:has_field_def sees_field_def map_of_remap_SomeD2)(*>*)

lemma sees_field_fun:
  "P  C sees F,b:T in D; P  C sees F,b':T' in D'  b = b'  T' = T  D' = D"
(*<*)by(fastforce simp:sees_field_def dest:has_fields_fun)(*>*)

lemma sees_field_decl_above:
  "P  C sees F,b:T in D  P  C * D"
(*<*)
by(auto simp:sees_field_def
        intro: has_fields_decl_above map_of_SomeD map_of_remap_SomeD2)
(*>*)


lemma sees_field_idemp:
assumes sees: "P  C sees F,b:T in D"
shows "P  D sees F,b:T in D"
(*<*)
proof -
  obtain FDTs where C_flds: "P  C has_fields FDTs"
     and FDTs: "map_of (map (λ((F, D), b, T). (F, D, b, T)) FDTs) F = (D, b, T)"
     (is "?FDTs")
   using sees by(clarsimp simp: sees_field_def)
  have map: "C' fs. map_of (map ((λ((F, D), a). (F, D, a))  (λ(F, y). ((F, C'), y))) fs) F 
              = (D, b, T)
          D = C'  (F, b, T)  set fs"
    by(frule map_of_SomeD) clarsimp
―‹ ?FDTs ⟶ P ⊢ D sees F,b:T in D ›
  have "?FDTs  (FDTs. P  D has_fields FDTs
                            map_of (map (λ((F, D), a). (F, D, a)) FDTs) F = (D, b, T))"
  using C_flds proof induct
    case NObj: (has_fields_rec C' D' fs ms FDTs FDTs')
    then show ?case using map by (fastforce intro: has_fields_rec)
  next
    case Obj: (has_fields_Object D fs ms FDTs)
    then show ?case using map by(fastforce intro: has_fields_Object)
  qed
  then show ?thesis using FDTs
    by (smt map_eq_conv old.prod.case prod_cases3 sees_field_def split_cong)
qed
(*>*)

lemma has_field_sees_aux:
assumes hf: "P  C has_fields FDTs" and map: "map_of FDTs (F, C) = (b, T)"
shows "map_of (map (λ((F, D), b, T). (F, D, b, T)) FDTs) F = (C, b, T)"
proof -
  obtain D fs ms where fs: "class P C = Some(D,fs,ms)"
    using visible_fields_exist[OF assms] by clarsimp
  then obtain FDTs' where
     "FDTs = map (λ(F, b, T). ((F, C), b, T)) fs @ FDTs'  map_of FDTs' (F, C) = None"
    using has_fields_mono_lem2[OF hf fs map] by clarsimp
  then show ?thesis using map_of_Some_None_split[OF _ _ map] by auto
qed

lemma has_field_sees: "P  C has F,b:T in C  P  C sees F,b:T in C"
 by(auto simp:has_field_def sees_field_def has_field_sees_aux)

lemma has_field_is_class:
 "P  C has F,b:T in D  is_class P C"
(*<*)by (auto simp add: is_class_def has_field_def elim: Fields.induct)(*>*)

lemma has_field_is_class':
 "P  C has F,b:T in D  is_class P D"
(*<*)by(drule has_field_idemp, rule has_field_is_class, assumption)(*>*)

subsection "Functional lookup"

definition "method" :: "'m prog  cname  mname  cname × staticb × ty list × ty × 'm"
where
  "method P C M   THE (D,b,Ts,T,m). P  C sees M,b:Ts  T = m in D"

definition field  :: "'m prog  cname  vname  cname × staticb × ty"
where
  "field P C F    THE (D,b,T). P  C sees F,b:T in D"
                                                        
definition fields :: "'m prog  cname  ((vname × cname) × staticb × ty) list" 
where
  "fields P C    THE FDTs. P  C has_fields FDTs"

lemma fields_def2 [simp]: "P  C has_fields FDTs  fields P C = FDTs"
(*<*)by (unfold fields_def) (auto dest: has_fields_fun)(*>*)

lemma field_def2 [simp]: "P  C sees F,b:T in D  field P C F = (D,b,T)"
(*<*)by (unfold field_def) (auto dest: sees_field_fun)(*>*)

lemma method_def2 [simp]: "P  C sees M,b: TsT = m in D  method P C M = (D,b,Ts,T,m)"
(*<*)by (unfold method_def) (auto dest: sees_method_fun)(*>*)


text ‹ The following are the fields for initializing an object (non-static fields)
 and a class (just that class's static fields), respectively. ›

definition ifields :: "'m prog  cname  ((vname × cname) × staticb × ty) list" 
where
  "ifields P C    filter (λ((F,D),b,T). b = NonStatic) (fields P C)"

definition isfields :: "'m prog  cname  ((vname × cname) × staticb × ty) list" 
where
  "isfields P C    filter (λ((F,D),b,T). b = Static  D = C) (fields P C)"

lemma ifields_def2[simp]: " P  C has_fields FDTs   ifields P C = filter (λ((F,D),b,T). b = NonStatic) FDTs"
 by (simp add: ifields_def)

lemma isfields_def2[simp]: " P  C has_fields FDTs   isfields P C = filter (λ((F,D),b,T). b = Static  D = C) FDTs"
 by (simp add: isfields_def)

lemma ifields_def3: " P  C sees F,b:T in D; b = NonStatic   (((F,D),b,T)  set (ifields P C))"
(*<*) by (unfold ifields_def) (auto simp: sees_field_def map_of_SomeD map_of_remap_SomeD2) (*>*)

lemma isfields_def3: " P  C sees F,b:T in D; b = Static; D = C   (((F,D),b,T)  set (isfields P C))"
(*<*) by (unfold isfields_def) (auto simp: sees_field_def map_of_SomeD map_of_remap_SomeD2) (*>*)


definition seeing_class :: "'m prog  cname  mname  cname option" where
"seeing_class P C M =
  (if Ts T m D. P  C sees M,Static:TsT = m in D
 then Some (fst(method P C M))
 else None)"

lemma seeing_class_def2[simp]:
 "P  C sees M,Static:TsT = m in D  seeing_class P C M = Some D"
 by(fastforce simp: seeing_class_def)

(*<*)
end
(*>*)

Theory Value

(*  Title:      Jinja/Common/Value.thy
    Author:     David von Oheimb, Tobias Nipkow
    Copyright   1999 Technische Universitaet Muenchen
*)

section ‹ Jinja Values ›

theory Value imports TypeRel begin

type_synonym addr = nat

datatype val
  = Unit        ― ‹dummy result value of void expressions›
  | Null        ― ‹null reference›
  | Bool bool   ― ‹Boolean value›
  | Intg int    ― ‹integer value› 
  | Addr addr   ― ‹addresses of objects in the heap›

primrec the_Intg :: "val  int" where
  "the_Intg (Intg i) = i"

primrec the_Addr :: "val  addr" where
  "the_Addr (Addr a) = a"

primrec default_val :: "ty  val"   ― ‹default value for all types› where
  "default_val Void      = Unit"
| "default_val Boolean   = Bool False"
| "default_val Integer   = Intg 0"
| "default_val NT        = Null"
| "default_val (Class C) = Null"

end

Theory Objects

(*  Title:      JinjaDCI/Common/Objects.thy

    Author:     David von Oheimb, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/Objects.thy by David von Oheimb
*)

section ‹ Objects and the Heap ›

theory Objects imports TypeRel Value begin

subsection‹ Objects ›

type_synonym
  fields = "vname × cname  val"  ― ‹field name, defining class, value›
type_synonym
  obj = "cname × fields"    ― ‹class instance with class name and fields›
type_synonym
  sfields = "vname  val"  ― ‹field name to value›

definition obj_ty  :: "obj  ty"
where
  "obj_ty obj    Class (fst obj)"

 ― ‹ initializes a given list of fields ›
definition init_fields :: "((vname × cname) × staticb × ty) list  fields"
where
  "init_fields FDTs    (map_of  map (λ((F,D),b,T). ((F,D),default_val T))) FDTs"

definition init_sfields :: "((vname × cname) × staticb × ty) list  sfields"
where
  "init_sfields FDTs    (map_of  map (λ((F,D),b,T). (F,default_val T))) FDTs"
  
  ― ‹a new, blank object with default values for instance fields:›
definition blank :: "'m prog  cname  obj"
where
  "blank P C   (C,init_fields (ifields P C))"

  ― ‹a new, blank object with default values for static fields:›
definition sblank :: "'m prog  cname  sfields"
where
  "sblank P C  init_sfields (isfields P C)"

lemma [simp]: "obj_ty (C,fs) = Class C"
(*<*)by (simp add: obj_ty_def)(*>*)

(* replaced all vname, cname in below with `char list' and ⇀ with returned option
  so that pretty printing works  -SM *)
translations
  (type) "fields" <= (type) "char list × char list  val option"
  (type) "obj" <= (type) "char list × fields"
  (type) "sfields" <= (type) "char list  val option"

subsection‹ Heap ›

type_synonym heap  = "addr  obj"

(* replaced addr with nat and ⇀ with returned option so that pretty printing works  -SM *)
translations
 (type) "heap" <= (type) "nat  obj option"

abbreviation
  cname_of :: "heap  addr  cname" where
  "cname_of hp a == fst (the (hp a))"

definition new_Addr  :: "heap  addr option"
where
  "new_Addr h    if a. h a = None then Some(LEAST a. h a = None) else None"

definition cast_ok :: "'m prog  cname  heap  val  bool"
where
  "cast_ok P C h v    v = Null  P  cname_of h (the_Addr v) * C"

definition hext :: "heap  heap  bool" ("_  _" [51,51] 50)
where
  "h  h'    a C fs. h a = Some(C,fs)  (fs'. h' a = Some(C,fs'))"

primrec typeof_h :: "heap  val  ty option"  ("typeof⇘_")
where
  "typeofh  Unit    = Some Void"
| "typeofh  Null    = Some NT"
| "typeofh (Bool b) = Some Boolean"
| "typeofh (Intg i) = Some Integer"
| "typeofh (Addr a) = (case h a of None  None | Some(C,fs)  Some(Class C))"

lemma new_Addr_SomeD:
  "new_Addr h = Some a  h a = None"
 (*<*)by(fastforce simp: new_Addr_def split:if_splits intro:LeastI)(*>*)

lemma [simp]: "(typeofh v = Some Boolean) = (b. v = Bool b)"
 (*<*)by(induct v) auto(*>*)

lemma [simp]: "(typeofh v = Some Integer) = (i. v = Intg i)"
(*<*)by(cases v) auto(*>*)

lemma [simp]: "(typeofh v = Some NT) = (v = Null)"
 (*<*)by(cases v) auto(*>*)

lemma [simp]: "(typeofh v = Some(Class C)) = (a fs. v = Addr a  h a = Some(C,fs))"
 (*<*)by(cases v) auto(*>*)

lemma [simp]: "h a = Some(C,fs)  typeof(h(a(C,fs'))) v = typeofh v"
 (*<*)by(induct v) (auto simp:fun_upd_apply)(*>*)

text‹ For literal values the first parameter of @{term typeof} can be
set to @{term empty} because they do not contain addresses: ›

abbreviation
  typeof :: "val  ty option" where
  "typeof v == typeof_h Map.empty v"

lemma typeof_lit_typeof:
  "typeof v = Some T  typeofh v = Some T"
 (*<*)by(cases v) auto(*>*)

lemma typeof_lit_is_type: 
  "typeof v = Some T  is_type P T"
 (*<*)by (induct v) (auto simp:is_type_def)(*>*)


subsection ‹ Heap extension @{text"⊴"}

lemma hextI: "a C fs. h a = Some(C,fs)  (fs'. h' a = Some(C,fs'))  h  h'"
(*<*)by(auto simp: hext_def)(*>*)

lemma hext_objD: " h  h'; h a = Some(C,fs)   fs'. h' a = Some(C,fs')"
(*<*)by(auto simp: hext_def)(*>*)

lemma hext_refl [iff]: "h  h"
(*<*)by (rule hextI) fast(*>*)

lemma hext_new [simp]: "h a = None  h  h(ax)"
(*<*)by (rule hextI) (auto simp:fun_upd_apply)(*>*)

lemma hext_trans: " h  h'; h'  h''   h  h''"
(*<*)by (rule hextI) (fast dest: hext_objD)(*>*)

lemma hext_upd_obj: "h a = Some (C,fs)  h  h(a(C,fs'))"
(*<*)by (rule hextI) (auto simp:fun_upd_apply)(*>*)

lemma hext_typeof_mono: " h  h'; typeofh v = Some T   typeofh' v = Some T"
(*<*)
proof(cases v)
  case Addr assume "h  h'" and "typeofh v = T"
  then show ?thesis using Addr by(fastforce simp:hext_def)
qed simp_all
(*>*)

subsection‹ Static field information function ›

datatype init_state = Done | Processing | Prepared | Error
	― ‹@{term Done} = initialized›
	― ‹@{term Processing} = currently being initialized›
	― ‹@{term Prepared} = uninitialized and not currently being initialized›
	― ‹@{term Error} = previous initialization attempt resulted in erroneous state›

inductive iprog :: "init_state  init_state  bool" ("_ i _" [51,51] 50)
where
  [simp]: "Prepared i i"
| [simp]: "Processing i Done"
| [simp]: "Processing i Error"
| [simp]: "i i i"

lemma iprog_Done[simp]: "(Done i i) = (i = Done)"
 by(simp only: iprog.simps, simp)

lemma iprog_Error[simp]: "(Error i i) = (i = Error)"
 by(simp only: iprog.simps, simp)

lemma iprog_Processing[simp]: "(Processing i i) = (i = Done  i = Error  i = Processing)"
 by(simp only: iprog.simps, simp)

lemma iprog_trans: " i i i'; i' i i''   i i i''"
(*<*)by(case_tac i; case_tac i') simp_all(*>*)

subsection‹ Static Heap ›

text ‹The static heap (sheap) is used for storing information about static
 field values and initialization status for classes.›

type_synonym
  sheap = "cname  sfields × init_state"

translations
 (type) "sheap" <= (type) "char list  (sfields × init_state) option"

definition shext :: "sheap  sheap  bool" ("_ s _" [51,51] 50)
where
  "sh s sh'    C sfs i. sh C = Some(sfs,i)  (sfs' i'. sh' C = Some(sfs',i')  i i i')"


lemma shextI: "C sfs i. sh C = Some(sfs,i)  (sfs' i'. sh' C = Some(sfs',i')  i i i')  sh s sh'"
(*<*)by(auto simp: shext_def)(*>*)

lemma shext_objD: " sh s sh'; sh C = Some(sfs,i)   sfs' i'. sh' C = Some(sfs', i')  i i i'"
(*<*)by(auto simp: shext_def)(*>*)

lemma shext_refl [iff]: "sh s sh"
(*<*)by (rule shextI) auto(*>*)

lemma shext_new [simp]: "sh C = None  sh s sh(Cx)"
(*<*)by (rule shextI) (auto simp:fun_upd_apply)(*>*)

lemma shext_trans: " sh s sh'; sh' s sh''   sh s sh''"
(*<*)by (rule shextI) (fast dest: iprog_trans shext_objD)(*>*)

lemma shext_upd_obj: " sh C = Some (sfs,i); i i i'   sh s sh(C(sfs',i'))"
(*<*)by (rule shextI) (auto simp:fun_upd_apply)(*>*)

end

Theory Exceptions

(*  Title:      JinjaDCI/Common/Exceptions.thy

    Author:     Gerwin Klein, Martin Strecker, Susannah Mansky
    Copyright   2002 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/Exceptions.thy by Gerwin Klein and Martin Strecker
*)

section ‹ Exceptions ›

theory Exceptions imports Objects begin

definition ErrorCl :: "string" where "ErrorCl = ''Error''"
definition ThrowCl :: "string" where "ThrowCl = ''Throwable''"

definition NullPointer :: cname
where
  "NullPointer  ''NullPointer''"

definition ClassCast :: cname
where
  "ClassCast  ''ClassCast''"

definition OutOfMemory :: cname
where
  "OutOfMemory  ''OutOfMemory''"

definition NoClassDefFoundError :: cname
where
  "NoClassDefFoundError  ''NoClassDefFoundError''"

definition IncompatibleClassChangeError :: cname
where
  "IncompatibleClassChangeError  ''IncompatibleClassChangeError''"

definition NoSuchFieldError :: cname
where
  "NoSuchFieldError  ''NoSuchFieldError''"

definition NoSuchMethodError :: cname
where
  "NoSuchMethodError  ''NoSuchMethodError''"

definition sys_xcpts :: "cname set"
where
  "sys_xcpts    {NullPointer, ClassCast, OutOfMemory, NoClassDefFoundError,
                    IncompatibleClassChangeError, 
                    NoSuchFieldError, NoSuchMethodError}"

definition addr_of_sys_xcpt :: "cname  addr"
where
  "addr_of_sys_xcpt s  if s = NullPointer then 0 else
                        if s = ClassCast then 1 else
                        if s = OutOfMemory then 2 else
                        if s = NoClassDefFoundError then 3 else
                        if s = IncompatibleClassChangeError then 4 else
                        if s = NoSuchFieldError then 5 else
                        if s = NoSuchMethodError then 6 else undefined"


lemmas sys_xcpts_defs = NullPointer_def ClassCast_def OutOfMemory_def NoClassDefFoundError_def
                       IncompatibleClassChangeError_def NoSuchFieldError_def NoSuchMethodError_def

lemma Start_nsys_xcpts: "Start  sys_xcpts"
 by(simp add: Start_def sys_xcpts_def sys_xcpts_defs)

lemma Start_nsys_xcpts1 [simp]: "Start  NullPointer" "Start  ClassCast"
 "Start  OutOfMemory" "Start  NoClassDefFoundError"
 "Start  IncompatibleClassChangeError" "Start  NoSuchFieldError"
 "Start  NoSuchMethodError"
using Start_nsys_xcpts by(auto simp: sys_xcpts_def)

lemma Start_nsys_xcpts2 [simp]: "NullPointer  Start" "ClassCast  Start"
 "OutOfMemory  Start" "NoClassDefFoundError  Start"
 "IncompatibleClassChangeError  Start" "NoSuchFieldError  Start"
 "NoSuchMethodError  Start"
using Start_nsys_xcpts by(auto simp: sys_xcpts_def dest: sym)

definition start_heap :: "'c prog  heap"
where
  "start_heap G  Map.empty (addr_of_sys_xcpt NullPointer  blank G NullPointer)
                        (addr_of_sys_xcpt ClassCast  blank G ClassCast)
                        (addr_of_sys_xcpt OutOfMemory  blank G OutOfMemory)
                        (addr_of_sys_xcpt NoClassDefFoundError  blank G NoClassDefFoundError)
                        (addr_of_sys_xcpt IncompatibleClassChangeError  blank G IncompatibleClassChangeError)
                        (addr_of_sys_xcpt NoSuchFieldError  blank G NoSuchFieldError)
                        (addr_of_sys_xcpt NoSuchMethodError  blank G NoSuchMethodError)"

definition preallocated :: "heap  bool"
where
  "preallocated h  C  sys_xcpts. fs. h(addr_of_sys_xcpt C) = Some (C,fs)"

subsection "System exceptions"

lemma sys_xcpts_incl [simp]: "NullPointer  sys_xcpts  OutOfMemory  sys_xcpts
    ClassCast  sys_xcpts  NoClassDefFoundError  sys_xcpts
    IncompatibleClassChangeError  sys_xcpts  NoSuchFieldError  sys_xcpts
    NoSuchMethodError  sys_xcpts"
(*<*)by(simp add: sys_xcpts_def)(*>*)

lemma sys_xcpts_cases [consumes 1, cases set]:
  " C  sys_xcpts; P NullPointer; P OutOfMemory; P ClassCast; P NoClassDefFoundError;
  P IncompatibleClassChangeError; P NoSuchFieldError;
  P NoSuchMethodError   P C"
(*<*)by (auto simp: sys_xcpts_def)(*>*)

subsection "Starting heap"

lemma start_heap_sys_xcpts:
assumes "C  sys_xcpts"
shows "start_heap P (addr_of_sys_xcpt C) = Some(blank P C)"
by(rule sys_xcpts_cases[OF assms])
  (auto simp add: start_heap_def sys_xcpts_def addr_of_sys_xcpt_def sys_xcpts_defs)

lemma start_heap_classes:
 "start_heap P a = Some(C,fs)  C  sys_xcpts"
 by(simp add: start_heap_def blank_def split: if_split_asm)

lemma start_heap_nStart: "start_heap P a = Some obj  fst(obj)  Start"
 by(cases obj, auto dest!: start_heap_classes simp: Start_nsys_xcpts)

subsection "@{term preallocated}"

lemma preallocated_dom [simp]: 
  " preallocated h; C  sys_xcpts   addr_of_sys_xcpt C  dom h"
(*<*)by (fastforce simp:preallocated_def dom_def)(*>*)


lemma preallocatedD:
  " preallocated h; C  sys_xcpts   fs. h(addr_of_sys_xcpt C) = Some (C, fs)"
(*<*)by(auto simp: preallocated_def sys_xcpts_def)(*>*)


lemma preallocatedE [elim?]:
  " preallocated h;  C  sys_xcpts; fs. h(addr_of_sys_xcpt C) = Some(C,fs)  P h C
   P h C"
(*<*)by (fast dest: preallocatedD)(*>*)


lemma cname_of_xcp [simp]:
  " preallocated h; C  sys_xcpts   cname_of h (addr_of_sys_xcpt C) = C"
(*<*)by (auto elim: preallocatedE)(*>*)


lemma typeof_ClassCast [simp]:
  "preallocated h  typeofh (Addr(addr_of_sys_xcpt ClassCast)) = Some(Class ClassCast)" 
(*<*)by (auto elim: preallocatedE)(*>*)


lemma typeof_OutOfMemory [simp]:
  "preallocated h  typeofh (Addr(addr_of_sys_xcpt OutOfMemory)) = Some(Class OutOfMemory)" 
(*<*)by (auto elim: preallocatedE)(*>*)


lemma typeof_NullPointer [simp]:
  "preallocated h  typeofh (Addr(addr_of_sys_xcpt NullPointer)) = Some(Class NullPointer)" 
(*<*)by (auto elim: preallocatedE)(*>*)

lemma typeof_NoClassDefFoundError [simp]:
  "preallocated h  typeofh (Addr(addr_of_sys_xcpt NoClassDefFoundError)) = Some(Class NoClassDefFoundError)" 
(*<*)by (auto elim: preallocatedE)(*>*)

lemma typeof_IncompatibleClassChangeError [simp]:
  "preallocated h  typeofh (Addr(addr_of_sys_xcpt IncompatibleClassChangeError)) = Some(Class IncompatibleClassChangeError)" 
(*<*)by (auto elim: preallocatedE)(*>*)

lemma typeof_NoSuchFieldError [simp]:
  "preallocated h  typeofh (Addr(addr_of_sys_xcpt NoSuchFieldError)) = Some(Class NoSuchFieldError)" 
(*<*)by (auto elim: preallocatedE)(*>*)

lemma typeof_NoSuchMethodError [simp]:
  "preallocated h  typeofh (Addr(addr_of_sys_xcpt NoSuchMethodError)) = Some(Class NoSuchMethodError)" 
(*<*)by (auto elim: preallocatedE)(*>*)

lemma preallocated_hext:
  " preallocated h; h  h'   preallocated h'"
(*<*)by (simp add: preallocated_def hext_def)(*>*)

(*<*)
lemmas preallocated_upd_obj = preallocated_hext [OF _ hext_upd_obj]
lemmas preallocated_new  = preallocated_hext [OF _ hext_new]
(*>*)

lemma preallocated_start:
  "preallocated (start_heap P)"
 by(auto simp: start_heap_sys_xcpts blank_def preallocated_def)

end

Theory Expr

(*  Title:      JinjaDCI/J/Expr.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/Expr.thy by Tobias Nipkow
*)

section ‹ Expressions ›

theory Expr
imports "../Common/Exceptions"
begin

datatype bop = Eq | Add     ― ‹names of binary operations›

datatype 'a exp
  = new cname      ― ‹class instance creation›
  | Cast cname "('a exp)"      ― ‹type cast›
  | Val val      ― ‹value›
  | BinOp "('a exp)" bop "('a exp)"     ("_ «_» _" [80,0,81] 80)      ― ‹binary operation›
  | Var 'a                                               ― ‹local variable (incl. parameter)›
  | LAss 'a "('a exp)"     ("_:=_" [90,90]90)                    ― ‹local assignment›
  | FAcc "('a exp)" vname cname     ("__{_}" [10,90,99]90)      ― ‹field access›
  | SFAcc cname vname cname     ("_s_{_}" [10,90,99]90)      ― ‹static field access›
  | FAss "('a exp)" vname cname "('a exp)"     ("__{_} := _" [10,90,99,90]90)      ― ‹field assignment›
  | SFAss cname vname cname "('a exp)"     ("_s_{_} := _" [10,90,99,90]90)      ― ‹static field assignment›
  | Call "('a exp)" mname "('a exp list)"     ("__'(_')" [90,99,0] 90)            ― ‹method call›
  | SCall cname mname "('a exp list)"     ("_s_'(_')" [90,99,0] 90)            ― ‹static method call›
  | Block 'a ty "('a exp)"     ("'{_:_; _}")
  | Seq "('a exp)" "('a exp)"     ("_;;/ _"             [61,60]60)
  | Cond "('a exp)" "('a exp)" "('a exp)"     ("if '(_') _/ else _" [80,79,79]70)
  | While "('a exp)" "('a exp)"     ("while '(_') _"     [80,79]70)
  | throw "('a exp)"
  | TryCatch "('a exp)" cname 'a "('a exp)"     ("try _/ catch'(_ _') _"  [0,99,80,79] 70)
  | INIT cname "cname list" bool "('a exp)" ("INIT _ '(_,_')  _" [60,60,60,60] 60) ― ‹internal initialization command: class, list of superclasses to initialize, preparation flag; command on hold›
  | RI cname "('a exp)" "cname list" "('a exp)" ("RI '(_,_') ; _  _" [60,60,60,60] 60) ― ‹running of the initialization procedure for class with expression, classes still to initialize command on hold›

type_synonym
  expr = "vname exp"            ― ‹Jinja expression›
type_synonym
  J_mb = "vname list × expr"    ― ‹Jinja method body: parameter names and expression›
type_synonym
  J_prog = "J_mb prog"          ― ‹Jinja program›

type_synonym
  init_stack = "expr list × bool"  ― ‹Stack of expressions waiting on initialization in small step; indicator boolean True if current expression has been init checked›

text‹The semantics of binary operators: ›

fun binop :: "bop × val × val  val option" where
  "binop(Eq,v1,v2) = Some(Bool (v1 = v2))"
| "binop(Add,Intg i1,Intg i2) = Some(Intg(i1+i2))"
| "binop(bop,v1,v2) = None"

lemma [simp]:
  "(binop(Add,v1,v2) = Some v) = (i1 i2. v1 = Intg i1  v2 = Intg i2  v = Intg(i1+i2))"
(*<*)
apply(cases v1)
apply auto
apply(cases v2)
apply auto
done
(*>*)


lemma map_Val_throw_eq:
 "map Val vs @ throw ex # es = map Val vs' @ throw ex' # es'  ex = ex'"
apply(induct vs arbitrary: vs')
 apply(case_tac vs', auto)+
done

lemma map_Val_nthrow_neq:
 "map Val vs = map Val vs' @ throw ex' # es'  False"
apply(induct vs arbitrary: vs')
 apply(case_tac vs', auto)+
done

lemma map_Val_eq:
 "map Val vs = map Val vs'  vs = vs'"
apply(induct vs arbitrary: vs')
 apply(case_tac vs', auto)+
done


lemma init_rhs_neq [simp]: "e  INIT C (Cs,b)  e"
proof -
  have "size e  size (INIT C (Cs,b)  e)" by auto
  then show ?thesis by fastforce
qed

lemma init_rhs_neq' [simp]: "INIT C (Cs,b)  e  e"
proof -
  have "size e  size (INIT C (Cs,b)  e)" by auto
  then show ?thesis by fastforce
qed

lemma ri_rhs_neq [simp]: "e  RI(C,e');Cs  e"
proof -
  have "size e  size (RI(C,e');Cs  e)" by auto
  then show ?thesis by fastforce
qed

lemma ri_rhs_neq' [simp]: "RI(C,e');Cs  e  e"
proof -
  have "size e  size (RI(C,e');Cs  e)" by auto
  then show ?thesis by fastforce
qed

subsection "Syntactic sugar"

abbreviation (input)
  InitBlock:: "'a  ty  'a exp  'a exp  'a exp"   ("(1'{_:_ := _;/ _})") where
  "InitBlock V T e1 e2 == {V:T; V := e1;; e2}"

abbreviation unit where "unit == Val Unit"
abbreviation null where "null == Val Null"
abbreviation "addr a == Val(Addr a)"
abbreviation "true == Val(Bool True)"
abbreviation "false == Val(Bool False)"

abbreviation
  Throw :: "addr  'a exp" where
  "Throw a == throw(Val(Addr a))"

abbreviation
  THROW :: "cname  'a exp" where
  "THROW xc == Throw(addr_of_sys_xcpt xc)"


subsection‹Free Variables›

primrec fv :: "expr  vname set" and fvs :: "expr list  vname set" where
  "fv(new C) = {}"
| "fv(Cast C e) = fv e"
| "fv(Val v) = {}"
| "fv(e1 «bop» e2) = fv e1  fv e2"
| "fv(Var V) = {V}"
| "fv(LAss V e) = {V}  fv e"
| "fv(eF{D}) = fv e"
| "fv(CsF{D}) = {}"
| "fv(e1F{D}:=e2) = fv e1  fv e2"
| "fv(CsF{D}:=e2) = fv e2"
| "fv(eM(es)) = fv e  fvs es"
| "fv(CsM(es)) = fvs es"
| "fv({V:T; e}) = fv e - {V}"
| "fv(e1;;e2) = fv e1  fv e2"
| "fv(if (b) e1 else e2) = fv b  fv e1  fv e2"
| "fv(while (b) e) = fv b  fv e"
| "fv(throw e) = fv e"
| "fv(try e1 catch(C V) e2) = fv e1  (fv e2 - {V})"
| "fv(INIT C (Cs,b)  e) = fv e"
| "fv(RI (C,e);Cs  e') = fv e  fv e'"
| "fvs([]) = {}"
| "fvs(e#es) = fv e  fvs es"

lemma [simp]: "fvs(es1 @ es2) = fvs es1  fvs es2"
(*<*)by (induct es1 type:list) auto(*>*)

lemma [simp]: "fvs(map Val vs) = {}"
(*<*)by (induct vs) auto(*>*)


subsection‹Accessing expression constructor arguments›

fun val_of :: "'a exp  val option" where
"val_of (Val v) = Some v" |
"val_of _ = None"

lemma val_of_spec: "val_of e = Some v  e = Val v"
proof(cases e) qed(auto)

fun lass_val_of :: "'a exp  ('a × val) option" where
"lass_val_of (V:=Val v) = Some (V, v)" |
"lass_val_of _ = None"

lemma lass_val_of_spec:
assumes "lass_val_of e = a"
shows "e = (fst a:=Val (snd a))"
using assms proof(cases e)
  case (LAss V e') then show ?thesis using assms proof(cases e')qed(auto)
qed(auto)

fun map_vals_of :: "'a exp list  val list option" where
"map_vals_of (e#es) = (case val_of e of Some v  (case map_vals_of es of Some vs  Some (v#vs) 
                                                                        | _  None)
                                      | _  None)" |
"map_vals_of [] = Some []"

lemma map_vals_of_spec: "map_vals_of es = Some vs  es = map Val vs"
proof(induct es arbitrary: vs) qed(auto simp: val_of_spec)

lemma map_vals_of_Vals[simp]: "map_vals_of (map Val vs) = vs" by(induct vs, auto)

lemma map_vals_of_throw[simp]:
 "map_vals_of (map Val vs @ throw e # es') = None"
 by(induct vs, auto)


fun bool_of :: "'a exp  bool option" where
"bool_of true = Some True" |
"bool_of false = Some False" |
"bool_of _ = None"

lemma bool_of_specT:
assumes "bool_of e = Some True" shows "e = true"
proof -
  have "bool_of e = Some True" by fact
  then show ?thesis
  proof(cases e)
    case (Val x3) with assms show ?thesis
    proof(cases x3)
      case (Bool x) with assms Val show ?thesis
      proof(cases x)qed(auto)
    qed(simp_all)
  qed(auto)
qed

lemma bool_of_specF:
assumes "bool_of e = Some False" shows "e = false"
proof -
  have "bool_of e = Some False" by fact
  then show ?thesis
  proof(cases e)
    case (Val x3) with assms show ?thesis
    proof(cases x3)
      case (Bool x) with assms Val show ?thesis
      proof(cases x)qed(auto)
    qed(simp_all)
  qed(auto)
qed


fun throw_of :: "'a exp  'a exp option" where
"throw_of (throw e') = Some e'" |
"throw_of _ = None"

lemma throw_of_spec: "throw_of e = Some e'  e = throw e'"
proof(cases e) qed(auto)

fun init_exp_of :: "'a exp  'a exp option" where
"init_exp_of (INIT C (Cs,b)  e) = Some e" |
"init_exp_of (RI(C,e');Cs  e) = Some e" |
"init_exp_of _ = None"

lemma init_exp_of_neq [simp]: "init_exp_of e = e'  e'  e" by(cases e, auto)
lemma init_exp_of_neq'[simp]: "init_exp_of e = e'  e  e'" by(cases e, auto)


subsection‹Class initialization›

text ‹ This section defines a few functions that return information
 about an expression's current initialization status. ›

 ― ‹ True if expression contains @{text INIT}, @{text RI}, or a call to a static method @{term clinit}
primrec sub_RI :: "'a exp  bool" and sub_RIs :: "'a exp list  bool" where
  "sub_RI(new C) = False"
| "sub_RI(Cast C e) = sub_RI e"
| "sub_RI(Val v) = False"
| "sub_RI(e1 «bop» e2) = (sub_RI e1  sub_RI e2)"
| "sub_RI(Var V) = False"
| "sub_RI(LAss V e) = sub_RI e"
| "sub_RI(eF{D}) = sub_RI e"
| "sub_RI(CsF{D}) = False"
| "sub_RI(e1F{D}:=e2) = (sub_RI e1  sub_RI e2)"
| "sub_RI(CsF{D}:=e2) = sub_RI e2"
| "sub_RI(eM(es)) = (sub_RI e  sub_RIs es)"
| "sub_RI(CsM(es)) = (M = clinit  sub_RIs es)"
| "sub_RI({V:T; e}) = sub_RI e"
| "sub_RI(e1;;e2) = (sub_RI e1  sub_RI e2)"
| "sub_RI(if (b) e1 else e2) = (sub_RI b  sub_RI e1  sub_RI e2)"
| "sub_RI(while (b) e) = (sub_RI b  sub_RI e)"
| "sub_RI(throw e) = sub_RI e"
| "sub_RI(try e1 catch(C V) e2) = (sub_RI e1  sub_RI e2)"
| "sub_RI(INIT C (Cs,b)  e) = True"
| "sub_RI(RI (C,e);Cs  e') = True"
| "sub_RIs([]) = False"
| "sub_RIs(e#es) = (sub_RI e  sub_RIs es)"


lemmas sub_RI_sub_RIs_induct = sub_RI.induct sub_RIs.induct

lemma nsub_RIs_def[simp]:
 "¬sub_RIs es  e  set es. ¬sub_RI e"
 by(induct es, auto)

lemma sub_RI_base:
 "e = INIT C (Cs, b)  e'  e = RI(C,e0);Cs  e'  sub_RI e"
 by(cases e, auto)

lemma nsub_RI_Vals[simp]: "¬sub_RIs (map Val vs)"
 by(induct vs, auto)

lemma lass_val_of_nsub_RI: "lass_val_of e = a  ¬sub_RI e"
 by(drule lass_val_of_spec, simp)


 ― ‹ is not currently initializing class @{text C'} (point past checking flag) ›
primrec not_init :: "cname  'a exp  bool" and not_inits :: "cname  'a exp list  bool" where
  "not_init C' (new C) = True"
| "not_init C' (Cast C e) = not_init C' e"
| "not_init C' (Val v) = True"
| "not_init C' (e1 «bop» e2) = (not_init C' e1  not_init C' e2)"
| "not_init C' (Var V) = True"
| "not_init C' (LAss V e) = not_init C' e"
| "not_init C' (eF{D}) = not_init C' e"
| "not_init C' (CsF{D}) = True"
| "not_init C' (e1F{D}:=e2) = (not_init C' e1  not_init C' e2)"
| "not_init C' (CsF{D}:=e2) = not_init C' e2"
| "not_init C' (eM(es)) = (not_init C' e  not_inits C' es)"
| "not_init C' (CsM(es)) = not_inits C' es"
| "not_init C' ({V:T; e}) = not_init C' e"
| "not_init C' (e1;;e2) = (not_init C' e1  not_init C' e2)"
| "not_init C' (if (b) e1 else e2) = (not_init C' b  not_init C' e1  not_init C' e2)"
| "not_init C' (while (b) e) = (not_init C' b  not_init C' e)"
| "not_init C' (throw e) = not_init C' e"
| "not_init C' (try e1 catch(C V) e2) = (not_init C' e1  not_init C' e2)"
| "not_init C' (INIT C (Cs,b)  e) = ((b  Cs = Nil  C'  hd Cs)  C'  set(tl Cs)  not_init C' e)"
| "not_init C' (RI (C,e);Cs  e') = (C'  set (C#Cs)  not_init C' e  not_init C' e')"
| "not_inits C' ([]) = True"
| "not_inits C' (e#es) = (not_init C' e  not_inits C' es)"

lemma not_inits_def'[simp]:
 "not_inits C es  e  set es. not_init C e"
 by(induct es, auto)

lemma nsub_RIs_not_inits_aux: "e  set es. ¬sub_RI e  not_init C e
   ¬sub_RIs es  not_inits C es"
 by(induct es, auto)

lemma nsub_RI_not_init: "¬sub_RI e  not_init C e"
proof(induct e) qed(auto intro: nsub_RIs_not_inits_aux)

lemma nsub_RIs_not_inits: "¬sub_RIs es  not_inits C es"
apply(rule nsub_RIs_not_inits_aux)
 apply(simp_all add: nsub_RI_not_init)
done

subsection‹Subexpressions›

 ― ‹ all strictly smaller subexpressions; does not include self ›
 primrec subexp :: "'a exp  'a exp set" and subexps :: "'a exp list  'a exp set" where
  "subexp(new C) = {}"
| "subexp(Cast C e) = {e}  subexp e"
| "subexp(Val v) = {}"
| "subexp(e1 «bop» e2) = {e1, e2}  subexp e1  subexp e2"
| "subexp(Var V) = {}"
| "subexp(LAss V e) = {e}  subexp e"
| "subexp(eF{D}) = {e}  subexp e"
| "subexp(CsF{D}) = {}"
| "subexp(e1F{D}:=e2) = {e1, e2}  subexp e1  subexp e2"
| "subexp(CsF{D}:=e2) = {e2} subexp e2"
| "subexp(eM(es)) = {e}  set es  subexp e  subexps es"
| "subexp(CsM(es)) = set es  subexps es"
| "subexp({V:T; e}) = {e}  subexp e"
| "subexp(e1;;e2) = {e1, e2}  subexp e1  subexp e2"
| "subexp(if (b) e1 else e2) = {b, e1, e2}  subexp b  subexp e1  subexp e2"
| "subexp(while (b) e) = {b, e}  subexp b  subexp e"
| "subexp(throw e) = {e}  subexp e"
| "subexp(try e1 catch(C V) e2) = {e1, e2}  subexp e1  subexp e2"
| "subexp(INIT C (Cs,b)  e) = {e}  subexp e"
| "subexp(RI (C,e);Cs  e') = {e, e'}  subexp e  subexp e'"
| "subexps([]) = {}"
| "subexps(e#es) = {e}  subexp e  subexps es"


lemmas subexp_subexps_induct = subexp.induct subexps.induct

abbreviation subexp_of :: "'a exp  'a exp  bool" where
 "subexp_of e e'  e  subexp e'"

lemma subexp_size_le:
 "(e'  subexp e  size e' < size e)  (e'  subexps es  size e' < size_list size es)"
proof(induct rule: subexp_subexps.induct)
  case Call:11 then show ?case using not_less_eq size_list_estimation by fastforce
next
  case SCall:12 then show ?case using not_less_eq size_list_estimation by fastforce
qed(auto)

lemma subexps_def2: "subexps es = set es  (e  set es. subexp e)" by(induct es, auto)

 ― ‹ strong induction ›
lemma shows subexp_induct[consumes 1]: 
"(e. subexp e = {}  R e)  (e. (e'. e'  subexp e  R e')  R e)
    (es. (e'. e'  subexps es  R e')  Rs es)  (e'. e'  subexp e  R e')  R e"
and subexps_induct[consumes 1]:
 "(es. subexps es = {}  Rs es)  (e. (e'. e'  subexp e  R e')  R e)
    (es. (e'. e'  subexps es  R e')  Rs es)  (e'. e'  subexps es  R e')  Rs es"
proof(induct rule: subexp_subexps_induct)
  case (Cast x1 x2)
  then have "(e'. subexp_of e' x2  R e')  R x2" by fast
  then have "(e'. subexp_of e' (Cast x1 x2)  R e')" by auto
  then show ?case using Cast.prems(2) by fast
next
  case (BinOp x1 x2 x3)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. subexp_of e' x3  R e')  R x3"
   by fast+
  then have "(e'. subexp_of e' (x1 «x2» x3)  R e')" by auto
  then show ?case using BinOp.prems(2) by fast
next
  case (LAss x1 x2)
  then have "(e'. subexp_of e' x2  R e')  R x2" by fast
  then have "(e'. subexp_of e' (LAss x1 x2)  R e')" by auto
  then show ?case using LAss.prems(2) by fast
next
  case (FAcc x1 x2 x3)
  then have "(e'. subexp_of e' x1  R e')  R x1" by fast
  then have "(e'. subexp_of e' (x1x2{x3})  R e')" by auto
  then show ?case using FAcc.prems(2) by fast
next
  case (FAss x1 x2 x3 x4)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. subexp_of e' x4  R e')  R x4"
   by fast+
  then have "(e'. subexp_of e' (x1x2{x3} := x4)  R e')" by auto
  then show ?case using FAss.prems(2) by fast
next
  case (SFAss x1 x2 x3 x4)
  then have "(e'. subexp_of e' x4  R e')  R x4" by fast
  then have "(e'. subexp_of e' (x1sx2{x3} := x4)  R e')" by auto
  then show ?case using SFAss.prems(2) by fast
next
  case (Call x1 x2 x3)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. e'  subexps x3  R e')  Rs x3"
   by fast+
  then have "(e'. subexp_of e' (x1x2(x3))  R e')" using subexps_def2 by auto
  then show ?case using Call.prems(2) by fast
next
  case (SCall x1 x2 x3)
  then have "(e'. e'  subexps x3  R e')  Rs x3" by fast
  then have "(e'. subexp_of e' (x1sx2(x3))  R e')" using subexps_def2 by auto
  then show ?case using SCall.prems(2) by fast
next
  case (Block x1 x2 x3)
  then have "(e'. subexp_of e' x3  R e')  R x3" by fast
  then have "(e'. subexp_of e' {x1:x2; x3}  R e')" by auto
  then show ?case using Block.prems(2) by fast
next
  case (Seq x1 x2)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. subexp_of e' x2  R e')  R x2"
   by fast+
  then have "(e'. subexp_of e' (x1;; x2)  R e')" by auto
  then show ?case using Seq.prems(2) by fast
next
  case (Cond x1 x2 x3)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. subexp_of e' x2  R e')  R x2"
    and "(e'. subexp_of e' x3  R e')  R x3" by fast+
  then have "(e'. subexp_of e' (if (x1) x2 else x3)  R e')" by auto
  then show ?case using Cond.prems(2) by fast
next
  case (While x1 x2)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. subexp_of e' x2  R e')  R x2"
   by fast+
  then have "(e'. subexp_of e' (while (x1) x2)  R e')" by auto
  then show ?case using While.prems(2) by fast
next
  case (throw x)
  then have "(e'. subexp_of e' x  R e')  R x" by fast
  then have "(e'. subexp_of e' (throw x)  R e')" by auto
  then show ?case using throw.prems(2) by fast
next
  case (TryCatch x1 x2 x3 x4)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. subexp_of e' x4  R e')  R x4"
   by fast+
  then have "(e'. subexp_of e' (try x1 catch(x2 x3) x4)  R e')" by auto
  then show ?case using TryCatch.prems(2) by fast
next
  case (INIT x1 x2 x3 x4)
  then have "(e'. subexp_of e' x4  R e')  R x4" by fast
  then have "(e'. subexp_of e' (INIT x1 (x2,x3)  x4)  R e')" by auto
  then show ?case using INIT.prems(2) by fast
next
  case (RI x1 x2 x3 x4)
  then have "(e'. subexp_of e' x2  R e')  R x2" and "(e'. subexp_of e' x4  R e')  R x4"
   by fast+
  then have "(e'. subexp_of e' (RI (x1,x2) ; x3  x4)  R e')" by auto
  then show ?case using RI.prems(2) by fast
next
  case (Cons_exp x1 x2)
  then have "(e'. subexp_of e' x1  R e')  R x1" and "(e'. e'  subexps x2  R e')  Rs x2"
   by fast+
  then have "(e'. e'  subexps (x1 # x2)  R e')" using subexps_def2 by auto
  then show ?case using Cons_exp.prems(3) by fast
qed(auto)


subsection"Final expressions"
(* these definitions and most of the lemmas were in BigStep.thy in the original Jinja *)

definition final :: "'a exp  bool"
where
  "final e    (v. e = Val v)  (a. e = Throw a)"

definition finals:: "'a exp list  bool"
where
  "finals es    (vs. es = map Val vs)  (vs a es'. es = map Val vs @ Throw a # es')"

lemma [simp]: "final(Val v)"
(*<*)by(simp add:final_def)(*>*)

lemma [simp]: "final(throw e) = (a. e = addr a)"
(*<*)by(simp add:final_def)(*>*)

lemma finalE: " final e;  v. e = Val v  R;  a. e = Throw a  R   R"
(*<*)by(auto simp:final_def)(*>*)

lemma final_fv[iff]: "final e  fv e = {}"
 by (auto simp: final_def)

lemma finalsE:
 " finals es;  vs. es = map Val vs  R;  vs a es'. es = map Val vs @ Throw a # es'  R   R"
(*<*)by(auto simp:finals_def)(*>*)

lemma [iff]: "finals []"
(*<*)by(simp add:finals_def)(*>*)

lemma [iff]: "finals (Val v # es) = finals es"
(*<*)
apply(clarsimp simp add: finals_def)
apply(rule iffI)
 apply(erule disjE)
  apply simp
 apply(rule disjI2)
 apply clarsimp
 apply(case_tac vs)
  apply simp
 apply fastforce
apply(erule disjE)
 apply clarsimp
apply(rule disjI2)
apply clarsimp
apply(rule_tac x = "v#vs" in exI)
apply simp
done
(*>*)

lemma finals_app_map[iff]: "finals (map Val vs @ es) = finals es"
(*<*)by(induct_tac vs, auto)(*>*)

lemma [iff]: "finals (map Val vs)"
(*<*)using finals_app_map[of vs "[]"]by(simp)(*>*)

lemma [iff]: "finals (throw e # es) = (a. e = addr a)"
(*<*)
apply(simp add:finals_def)
apply(rule iffI)
 apply clarsimp
 apply(case_tac vs)
  apply simp
 apply fastforce
apply clarsimp
apply(rule_tac x = "[]" in exI)
apply simp
done
(*>*)

lemma not_finals_ConsI: "¬ final e  ¬ finals(e#es)"
 (*<*)
apply(clarsimp simp add:finals_def final_def)
apply(case_tac vs)
apply auto
done
(*>*)

lemma not_finals_ConsI2: "e = Val v  ¬ finals es  ¬ finals(e#es)"
 (*<*)
apply(clarsimp simp add:finals_def final_def)
apply(case_tac vs)
apply auto
done
(*>*)


end

Theory WellType

(*  Title:      JinjaDCI/J/WellType.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/WellType.thy by Tobias Nipkow
*)

section ‹ Well-typedness of Jinja expressions ›

theory WellType
imports "../Common/Objects" Expr
begin

type_synonym
  env  = "vname  ty"

inductive
  WT :: "[J_prog,env, expr     , ty     ]  bool"
         ("_,_  _ :: _"   [51,51,51]50)
  and WTs :: "[J_prog,env, expr list, ty list]  bool"
         ("_,_  _ [::] _" [51,51,51]50)
  for P :: J_prog
where
  
  WTNew:
  "is_class P C  
  P,E  new C :: Class C"

| WTCast:
  " P,E  e :: Class D;  is_class P C;  P  C * D  P  D * C 
   P,E  Cast C e :: Class C"

| WTVal:
  "typeof v = Some T 
  P,E  Val v :: T"

| WTVar:
  "E V = Some T 
  P,E  Var V :: T"

| WTBinOpEq:
  " P,E  e1 :: T1;  P,E  e2 :: T2; P  T1  T2  P  T2  T1 
   P,E  e1 «Eq» e2 :: Boolean"

| WTBinOpAdd:
  " P,E  e1 :: Integer;  P,E  e2 :: Integer 
   P,E  e1 «Add» e2 :: Integer"

| WTLAss:
  " E V = Some T;  P,E  e :: T';  P  T'  T; V  this 
   P,E  V:=e :: Void"

| WTFAcc:
  " P,E  e :: Class C;  P  C sees F,NonStatic:T in D 
   P,E  eF{D} :: T"

| WTSFAcc:
  " P  C sees F,Static:T in D 
   P,E  CsF{D} :: T"

| WTFAss:
  " P,E  e1 :: Class C;  P  C sees F,NonStatic:T in D;  P,E  e2 :: T';  P  T'  T 
   P,E  e1F{D}:=e2 :: Void"

| WTSFAss:
  "  P  C sees F,Static:T in D;  P,E  e2 :: T';  P  T'  T 
   P,E  CsF{D}:=e2 :: Void"

| WTCall:
  " P,E  e :: Class C;  P  C sees M,NonStatic:Ts  T = (pns,body) in D;
     P,E  es [::] Ts';  P  Ts' [≤] Ts 
   P,E  eM(es) :: T"

| WTSCall:
  " P  C sees M,Static:Ts  T = (pns,body) in D;
     P,E  es [::] Ts';  P  Ts' [≤] Ts; M  clinit 
   P,E  CsM(es) :: T"

| WTBlock:
  " is_type P T;  P,E(V  T)  e :: T' 
    P,E  {V:T; e} :: T'"

| WTSeq:
  " P,E  e1::T1;  P,E  e2::T2 
    P,E  e1;;e2 :: T2"

| WTCond:
  " P,E  e :: Boolean;  P,E  e1::T1;  P,E  e2::T2;
     P  T1  T2  P  T2  T1;  P  T1  T2  T = T2;  P  T2  T1  T = T1 
   P,E  if (e) e1 else e2 :: T"

| WTWhile:
  " P,E  e :: Boolean;  P,E  c::T 
   P,E  while (e) c :: Void"

| WTThrow:
  "P,E  e :: Class C   
  P,E  throw e :: Void"

| WTTry:
  " P,E  e1 :: T;  P,E(V  Class C)  e2 :: T; is_class P C 
   P,E  try e1 catch(C V) e2 :: T"

― ‹well-typed expression lists›

| WTNil:
  "P,E  [] [::] []"

| WTCons:
  " P,E  e :: T; P,E  es [::] Ts 
    P,E  e#es [::] T#Ts"

(*<*)
declare WT_WTs.intros[intro!] (* WTNil[iff] *)

lemmas WT_WTs_induct = WT_WTs.induct [split_format (complete)]
  and WT_WTs_inducts = WT_WTs.inducts [split_format (complete)]
(*>*)

lemma init_nwt [simp]:"¬P,E  INIT C (Cs,b)  e :: T"
 by(auto elim:WT.cases)
lemma ri_nwt [simp]:"¬P,E  RI(C,e);Cs  e' :: T"
 by(auto elim:WT.cases)

lemma [iff]: "(P,E  [] [::] Ts) = (Ts = [])"
(*<*)
apply(rule iffI)
apply (auto elim: WTs.cases)
done
(*>*)

lemma [iff]: "(P,E  e#es [::] T#Ts) = (P,E  e :: T  P,E  es [::] Ts)"
(*<*)
apply(rule iffI)
apply (auto elim: WTs.cases)
done
(*>*)

lemma [iff]: "(P,E  (e#es) [::] Ts) =
  (U Us. Ts = U#Us  P,E  e :: U  P,E  es [::] Us)"
(*<*)
apply(rule iffI)
apply (auto elim: WTs.cases)
done
(*>*)

lemma [iff]: "Ts. (P,E  es1 @ es2 [::] Ts) =
  (Ts1 Ts2. Ts = Ts1 @ Ts2  P,E  es1 [::] Ts1  P,E  es2[::]Ts2)"
(*<*)
apply(induct es1 type:list)
 apply simp
apply clarsimp
apply(erule thin_rl)
apply (rule iffI)
 apply clarsimp
 apply(rule exI)+
 apply(rule conjI)
  prefer 2 apply blast
 apply simp
apply fastforce
done
(*>*)

lemma [iff]: "P,E  Val v :: T = (typeof v = Some T)"
(*<*)
apply(rule iffI)
apply (auto elim: WT.cases)
done
(*>*)

lemma [iff]: "P,E  Var V :: T = (E V = Some T)"
(*<*)
apply(rule iffI)
apply (auto elim: WT.cases)
done
(*>*)

lemma [iff]: "P,E  e1;;e2 :: T2 = (T1. P,E  e1::T1  P,E  e2::T2)"
(*<*)
apply(rule iffI)
apply (auto elim: WT.cases)
done
(*>*)

lemma [iff]: "(P,E  {V:T; e} :: T') = (is_type P T  P,E(VT)  e :: T')"
(*<*)
apply(rule iffI)
apply (auto elim: WT.cases)
done
(*>*)

(*<*)
inductive_cases WT_elim_cases[elim!]:
  "P,E  V :=e :: T"
  "P,E  if (e) e1 else e2 :: T"
  "P,E  while (e) c :: T"
  "P,E  throw e :: T"
  "P,E  try e1 catch(C V) e2 :: T"
  "P,E  Cast D e :: T"
  "P,E  aF{D} :: T"
  "P,E  CsF{D} :: T"
  "P,E  aF{D} := v :: T"
  "P,E  CsF{D} := v :: T"
  "P,E  e1 «bop» e2 :: T"
  "P,E  new C :: T"
  "P,E  eM(ps) :: T"
  "P,E  CsM(ps) :: T"
(*>*)


lemma wt_env_mono:
  "P,E  e :: T  (E'. E m E'  P,E'  e :: T)" and 
  "P,E  es [::] Ts  (E'. E m E'  P,E'  es [::] Ts)"
(*<*)
apply(induct rule: WT_WTs_inducts)
apply(simp add: WTNew)
apply(fastforce simp: WTCast)
apply(fastforce simp: WTVal)
apply(simp add: WTVar map_le_def dom_def)
apply(fastforce simp: WTBinOpEq)
apply(fastforce simp: WTBinOpAdd)
apply(force simp:map_le_def)
apply(fastforce simp: WTFAcc)
apply(fastforce)
apply(fastforce simp: WTFAss del:WT_WTs.intros WT_elim_cases)
apply(fastforce)
apply(fastforce simp: WTCall)
apply(fastforce)
apply(fastforce simp: map_le_def WTBlock)
apply(fastforce simp: WTSeq)
apply(fastforce simp: WTCond)
apply(fastforce simp: WTWhile)
apply(fastforce simp: WTThrow)
apply(fastforce simp: WTTry map_le_def dom_def)
apply(simp add: WTNil)
apply(simp add: WTCons)
done
(*>*)


lemma WT_fv: "P,E  e :: T  fv e  dom E"
and "P,E  es [::] Ts  fvs es  dom E"
(*<*)
apply(induct rule:WT_WTs.inducts)
apply(simp_all del: fun_upd_apply)
apply fast+
done

lemma WT_nsub_RI: "P,E  e :: T  ¬sub_RI e"
 and WTs_nsub_RIs: "P,E  es [::] Ts  ¬sub_RIs es"
proof(induct rule: WT_WTs.inducts) qed(simp_all)

end
(*>*)

Theory WellTypeRT

(*  Title:      JinjaDCI/J/WellTypeRT.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/WellTypeRT.thy by Tobias Nipkow
*)

section ‹ Runtime Well-typedness ›

theory WellTypeRT
imports WellType
begin

inductive
  WTrt :: "J_prog  heap  sheap  env  expr  ty  bool"
  and WTrts :: "J_prog  heap  sheap  env  expr list  ty list  bool"
  and WTrt2 :: "[J_prog,env,heap,sheap,expr,ty]  bool"
        ("_,_,_,_  _ : _"   [51,51,51,51]50)
  and WTrts2 :: "[J_prog,env,heap,sheap,expr list, ty list]  bool"
        ("_,_,_,_  _ [:] _" [51,51,51,51]50)
  for P :: J_prog and h :: heap and sh :: sheap
where
  
  "P,E,h,sh  e : T  WTrt P h sh E e T"
| "P,E,h,sh  es[:]Ts  WTrts P h sh E es Ts"

| WTrtNew:
  "is_class P C  
  P,E,h,sh  new C : Class C"

| WTrtCast:
  " P,E,h,sh  e : T; is_refT T; is_class P C 
   P,E,h,sh  Cast C e : Class C"

| WTrtVal:
  "typeofh v = Some T 
  P,E,h,sh  Val v : T"

| WTrtVar:
  "E V = Some T  
  P,E,h,sh  Var V : T"

| WTrtBinOpEq:
  " P,E,h,sh  e1 : T1;  P,E,h,sh  e2 : T2 
   P,E,h,sh  e1 «Eq» e2 : Boolean"

| WTrtBinOpAdd:
  " P,E,h,sh  e1 : Integer;  P,E,h,sh  e2 : Integer 
   P,E,h,sh  e1 «Add» e2 : Integer"

| WTrtLAss:
  " E V = Some T;  P,E,h,sh  e : T';  P  T'  T 
    P,E,h,sh  V:=e : Void"

| WTrtFAcc:
  " P,E,h,sh  e : Class C; P  C has F,NonStatic:T in D  
  P,E,h,sh  eF{D} : T"

| WTrtFAccNT:
  "P,E,h,sh  e : NT 
  P,E,h,sh  eF{D} : T"

| WTrtSFAcc:
  " P  C has F,Static:T in D  
  P,E,h,sh  CsF{D} : T"

| WTrtFAss:
  " P,E,h,sh  e1 : Class C;  P  C has F,NonStatic:T in D; P,E,h,sh  e2 : T2;  P  T2  T 
   P,E,h,sh  e1F{D}:=e2 : Void"

| WTrtFAssNT:
  " P,E,h,sh  e1:NT; P,E,h,sh  e2 : T2 
   P,E,h,sh  e1F{D}:=e2 : Void"

| WTrtSFAss:
  " P,E,h,sh  e2 : T2; P  C has F,Static:T in D; P  T2  T 
   P,E,h,sh  CsF{D}:=e2 : Void"

| WTrtCall:
  " P,E,h,sh  e : Class C; P  C sees M,NonStatic:Ts  T = (pns,body) in D;
     P,E,h,sh  es [:] Ts'; P  Ts' [≤] Ts 
   P,E,h,sh  eM(es) : T"

| WTrtCallNT:
  " P,E,h,sh  e : NT; P,E,h,sh  es [:] Ts 
   P,E,h,sh  eM(es) : T"

| WTrtSCall:
  " P  C sees M,Static:Ts  T = (pns,body) in D;
     P,E,h,sh  es [:] Ts'; P  Ts' [≤] Ts;
     M = clinit  sh D = (sfs,Processing)  es = map Val vs 
   P,E,h,sh  CsM(es) : T"

| WTrtBlock:
  "P,E(VT),h,sh  e : T'  
  P,E,h,sh  {V:T; e} : T'"

| WTrtSeq:
  " P,E,h,sh  e1:T1;  P,E,h,sh  e2:T2 
   P,E,h,sh  e1;;e2 : T2"

| WTrtCond:
  " P,E,h,sh  e : Boolean;  P,E,h,sh  e1:T1;  P,E,h,sh  e2:T2;
     P  T1  T2  P  T2  T1; P  T1  T2  T = T2; P  T2  T1  T = T1 
   P,E,h,sh  if (e) e1 else e2 : T"

| WTrtWhile:
  " P,E,h,sh  e : Boolean;  P,E,h,sh  c:T 
    P,E,h,sh  while(e) c : Void"

| WTrtThrow:
  " P,E,h,sh  e : Tr; is_refT Tr  
  P,E,h,sh  throw e : T"

| WTrtTry:
  " P,E,h,sh  e1 : T1;  P,E(V  Class C),h,sh  e2 : T2; P  T1  T2 
   P,E,h,sh  try e1 catch(C V) e2 : T2"

| WTrtInit:
  " P,E,h,sh  e : T; C'  set (C#Cs). is_class P C'; ¬sub_RI e;
     C'  set (tl Cs). sfs. sh C' = (sfs,Processing);
     b  (C'  set Cs. sfs. sh C' = (sfs,Processing));
     distinct Cs; supercls_lst P Cs 
   P,E,h,sh  INIT C (Cs, b)  e : T"

| WTrtRI:
  " P,E,h,sh  e : T; P,E,h,sh  e' : T'; C'  set (C#Cs). is_class P C'; ¬sub_RI e';
     C'  set (C#Cs). not_init C' e;
     C'  set Cs. sfs. sh C' = (sfs,Processing);
     sfs. sh C = (sfs, Processing)  (sh C = (sfs, Error)  e = THROW NoClassDefFoundError);
     distinct (C#Cs); supercls_lst P (C#Cs) 
   P,E,h,sh  RI(C, e);Cs  e' : T'"

― ‹well-typed expression lists›

| WTrtNil:
  "P,E,h,sh  [] [:] []"

| WTrtCons:
  " P,E,h,sh  e : T;  P,E,h,sh  es [:] Ts 
    P,E,h,sh  e#es [:] T#Ts"

(*<*)
declare WTrt_WTrts.intros[intro!] WTrtNil[iff]
declare
  WTrtFAcc[rule del] WTrtFAccNT[rule del] WTrtSFAcc[rule del]
  WTrtFAss[rule del] WTrtFAssNT[rule del] WTrtSFAss[rule del]
  WTrtCall[rule del] WTrtCallNT[rule del] WTrtSCall[rule del]

lemmas WTrt_induct = WTrt_WTrts.induct [split_format (complete)]
  and WTrt_inducts = WTrt_WTrts.inducts [split_format (complete)]
(*>*)


subsection‹Easy consequences›

lemma [iff]: "(P,E,h,sh  [] [:] Ts) = (Ts = [])"
(*<*)
apply(rule iffI)
apply (auto elim: WTrts.cases)
done
(*>*)

lemma [iff]: "(P,E,h,sh  e#es [:] T#Ts) = (P,E,h,sh  e : T  P,E,h,sh  es [:] Ts)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrts.cases)
done
(*>*)

lemma [iff]: "(P,E,h,sh  (e#es) [:] Ts) =
  (U Us. Ts = U#Us  P,E,h,sh  e : U  P,E,h,sh  es [:] Us)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrts.cases)
done
(*>*)

lemma [simp]: "Ts. (P,E,h,sh  es1 @ es2 [:] Ts) =
  (Ts1 Ts2. Ts = Ts1 @ Ts2  P,E,h,sh  es1 [:] Ts1 & P,E,h,sh  es2[:]Ts2)"
(*<*)
apply(induct_tac es1)
 apply simp
apply clarsimp
apply(erule thin_rl)
apply (rule iffI)
 apply clarsimp
 apply(rule exI)+
 apply(rule conjI)
  prefer 2 apply blast
 apply simp
apply fastforce
done
(*>*)

lemma [iff]: "P,E,h,sh  Val v : T = (typeofh v = Some T)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
(*>*)

lemma [iff]: "P,E,h,sh  Var v : T = (E v = Some T)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
(*>*)

lemma [iff]: "P,E,h,sh  e1;;e2 : T2 = (T1. P,E,h,sh  e1:T1  P,E,h,sh  e2:T2)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
(*>*)

lemma [iff]: "P,E,h,sh  {V:T; e} : T'  =  (P,E(VT),h,sh  e : T')"
(*<*)
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
(*>*)
(*<*)
inductive_cases WTrt_elim_cases[elim!]:
  "P,E,h,sh  v :=e : T"
  "P,E,h,sh  if (e) e1 else e2 : T"
  "P,E,h,sh  while(e) c : T"
  "P,E,h,sh  throw e : T"
  "P,E,h,sh  try e1 catch(C V) e2 : T"
  "P,E,h,sh  Cast D e : T"
  "P,E,h,sh  eF{D} : T"
  "P,E,h,sh  CsF{D} : T"
  "P,E,h,sh  eF{D} := v : T"
  "P,E,h,sh  CsF{D} := v : T"
  "P,E,h,sh  e1 «bop» e2 : T"
  "P,E,h,sh  new C : T"
  "P,E,h,sh  eM{D}(es) : T"
  "P,E,h,sh  CsM{D}(es) : T"
  "P,E,h,sh  INIT C (Cs,b)  e : T"
  "P,E,h,sh  RI(C,e);Cs  e' : T"
(*>*)

subsection‹Some interesting lemmas›

lemma WTrts_Val[simp]:
 "Ts. (P,E,h,sh  map Val vs [:] Ts) = (map (typeofh) vs = map Some Ts)"
(*<*)
apply(induct vs)
 apply simp
apply(case_tac Ts)
 apply simp
apply simp
done
(*>*)


lemma WTrts_same_length: "Ts. P,E,h,sh  es [:] Ts  length es = length Ts"
(*<*)by(induct es type:list)auto(*>*)


lemma WTrt_env_mono:
  "P,E,h,sh  e : T  (E'. E m E'  P,E',h,sh  e : T)" and
  "P,E,h,sh  es [:] Ts  (E'. E m E'  P,E',h,sh  es [:] Ts)"
(*<*)
proof(induct rule: WTrt_inducts)
  case (WTrtVar E V T)
  then show ?case by(simp add: WTrtVar map_le_def dom_def)
next
  case (WTrtLAss E V T e T')
  then show ?case by(force simp: map_le_def)
qed(fastforce intro: WTrt_WTrts.intros)+
(*>*)


lemma WTrt_hext_mono: "P,E,h,sh  e : T  h  h'  P,E,h',sh  e : T"
and WTrts_hext_mono: "P,E,h,sh  es [:] Ts  h  h'  P,E,h',sh  es [:] Ts"
(*<*)
apply(induct rule: WTrt_inducts)
apply(simp add: WTrtNew)
apply(fastforce simp: WTrtCast)
apply(fastforce simp: WTrtVal dest:hext_typeof_mono)
apply(simp add: WTrtVar)
apply(fastforce simp add: WTrtBinOpEq)
apply(fastforce simp add: WTrtBinOpAdd)
apply(fastforce simp add: WTrtLAss)
apply(fast intro: WTrtFAcc)
apply(simp add: WTrtFAccNT)
apply(fast intro: WTrtSFAcc)
apply(fastforce simp: WTrtFAss del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtFAssNT)
apply(fastforce simp: WTrtSFAss del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtCall)
apply(fastforce simp: WTrtCallNT)
using WTrtSCall apply blast
apply(fastforce)
apply(fastforce simp add: WTrtSeq)
apply(fastforce simp add: WTrtCond)
apply(fastforce simp add: WTrtWhile)
apply(fastforce simp add: WTrtThrow)
apply(fastforce simp: WTrtTry)
apply(simp add: WTrtInit)
apply(simp add: WTrtRI)
apply(simp add: WTrtNil)
apply(simp add: WTrtCons)
done
(*>*)

lemma WTrt_shext_mono: "P,E,h,sh  e : T  sh s sh'  ¬sub_RI e  P,E,h,sh'  e : T"
and WTrts_shext_mono: "P,E,h,sh  es [:] Ts  sh s sh'  ¬sub_RIs es  P,E,h,sh'  es [:] Ts"
(*<*)
by(induct rule: WTrt_inducts)
  (auto simp add: WTrt_WTrts.intros)
(*>*)

lemma WTrt_hext_shext_mono: "P,E,h,sh  e : T
    h  h'  sh s sh'  ¬sub_RI e  P,E,h',sh'  e : T"
 by(auto intro: WTrt_hext_mono WTrt_shext_mono)

lemma WTrts_hext_shext_mono: "P,E,h,sh  es [:] Ts
    h  h'  sh s sh'  ¬sub_RIs es  P,E,h',sh'  es [:] Ts"
 by(auto intro: WTrts_hext_mono WTrts_shext_mono)


lemma WT_implies_WTrt: "P,E  e :: T  P,E,h,sh  e : T"
and WTs_implies_WTrts: "P,E  es [::] Ts  P,E,h,sh  es [:] Ts"
(*<*)
apply(induct rule: WT_WTs_inducts)
apply fast
apply (fast)
apply(fastforce dest:typeof_lit_typeof)
apply(simp)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(meson WTrtFAcc has_visible_field)
apply(meson WTrtSFAcc has_visible_field)
apply(meson WTrtFAss has_visible_field)
apply(meson WTrtSFAss has_visible_field)
apply(fastforce simp: WTrtCall)
apply(fastforce simp: WTrtSCall)
apply(fastforce)
apply(fastforce)
apply(fastforce simp: WTrtCond)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(simp)
apply(simp)
done
(*>*)

end

Theory State

(*  Title:      JinjaDCI/J/State.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/State.thy by Tobias Nipkow
*)

section ‹ Program State ›

theory State imports "../Common/Exceptions" begin

type_synonym
  locals = "vname  val"      ― ‹local vars, incl. params and ``this''›
type_synonym
  state  = "heap × locals × sheap"

definition hp :: "state  heap"
where
  "hp    fst"
definition lcl :: "state  locals"
where
  "lcl    fst  snd"
definition shp :: "state  sheap"
where
  "shp    snd  snd"

(*<*)
declare hp_def[simp] lcl_def[simp] shp_def[simp]
(*>*)

end

Theory SystemClasses

(*  Title:     JinjaDCI/Common/SystemClasses.thy

    Author:     Gerwin Klein, Susannah Mansky
    Copyright   2002 Technische Universitaet Muenchen, 2019-20 UIUC
    
    Based on the Jinja theory Common/SystemClasses.thy by Gerwin Klein
*)

section ‹ System Classes ›

theory SystemClasses
imports Decl Exceptions
begin

text ‹
  This theory provides definitions for the @{text Object} class,
  and the system exceptions.
›

definition ObjectC :: "'m cdecl"
where
  "ObjectC  (Object, (undefined,[],[]))"

definition NullPointerC :: "'m cdecl"
where
  "NullPointerC  (NullPointer, (Object,[],[]))"

definition ClassCastC :: "'m cdecl"
where
  "ClassCastC  (ClassCast, (Object,[],[]))"

definition OutOfMemoryC :: "'m cdecl"
where
  "OutOfMemoryC  (OutOfMemory, (Object,[],[]))"

definition NoClassDefFoundC :: "'m cdecl"
where
  "NoClassDefFoundC  (NoClassDefFoundError, (Object,[],[]))"

definition IncompatibleClassChangeC :: "'m cdecl"
where
  "IncompatibleClassChangeC  (IncompatibleClassChangeError, (Object,[],[]))"

definition NoSuchFieldC :: "'m cdecl"
where
  "NoSuchFieldC  (NoSuchFieldError, (Object,[],[]))"

definition NoSuchMethodC :: "'m cdecl"
where
  "NoSuchMethodC  (NoSuchMethodError, (Object,[],[]))"

definition SystemClasses :: "'m cdecl list"
where
  "SystemClasses  [ObjectC, NullPointerC, ClassCastC, OutOfMemoryC, NoClassDefFoundC,
  IncompatibleClassChangeC, NoSuchFieldC, NoSuchMethodC]"

end

Theory WellForm

(*  Title:      JinjaDCI/Common/WellForm.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/WellForm.thy by Tobias Nipkow
*)

section ‹ Generic Well-formedness of programs ›

theory WellForm imports TypeRel SystemClasses begin

text ‹\noindent This theory defines global well-formedness conditions
for programs but does not look inside method bodies.  Hence it works
for both Jinja and JVM programs. Well-typing of expressions is defined
elsewhere (in theory @{text WellType}).

Because Jinja does not have method overloading, its policy for method
overriding is the classical one: \emph{covariant in the result type
but contravariant in the argument types.} This means the result type
of the overriding method becomes more specific, the argument types
become more general.
›

type_synonym 'm wf_mdecl_test = "'m prog  cname  'm mdecl  bool"

definition wf_fdecl :: "'m prog  fdecl  bool"
where
  "wf_fdecl P  λ(F,b,T). is_type P T"

definition wf_mdecl :: "'m wf_mdecl_test  'm wf_mdecl_test"
where
  "wf_mdecl wf_md P C  λ(M,b,Ts,T,m).
  (Tset Ts. is_type P T)  is_type P T  wf_md P C (M,b,Ts,T,m)"

definition wf_clinit :: "'m mdecl list  bool" where
"wf_clinit ms = (m. (clinit,Static,[],Void,m)set ms)"

definition wf_cdecl :: "'m wf_mdecl_test  'm prog  'm cdecl  bool"
where
  "wf_cdecl wf_md P    λ(C,(D,fs,ms)).
  (fset fs. wf_fdecl P f)   distinct_fst fs 
  (mset ms. wf_mdecl wf_md P C m)   distinct_fst ms 
  (C  Object 
   is_class P D  ¬ P  D * C 
   ((M,b,Ts,T,m)set ms.
      D' b' Ts' T' m'. P  D sees M,b':Ts'  T' = m' in D' 
                       b = b'  P  Ts' [≤] Ts  P  T  T')) 
  wf_clinit ms"

definition wf_syscls :: "'m prog  bool"
where
  "wf_syscls P    {Object}  sys_xcpts  set(map fst P)"

definition wf_prog :: "'m wf_mdecl_test  'm prog  bool"
where
  "wf_prog wf_md P    wf_syscls P  (c  set P. wf_cdecl wf_md P c)  distinct_fst P"


subsection‹ Well-formedness lemmas ›

lemma class_wf: 
  "class P C = Some c; wf_prog wf_md P  wf_cdecl wf_md P (C,c)"
(*<*)by (unfold wf_prog_def class_def) (fast dest: map_of_SomeD)(*>*)


lemma class_Object [simp]: 
  "wf_prog wf_md P  C fs ms. class P Object = Some (C,fs,ms)"
(*<*)by (unfold wf_prog_def wf_syscls_def class_def)
        (auto simp: map_of_SomeI)
(*>*)


lemma is_class_Object [simp]:
  "wf_prog wf_md P  is_class P Object"
(*<*)by (simp add: is_class_def)(*>*)

lemma is_class_supclass:
assumes wf: "wf_prog wf_md P" and sub: "P  C * D"
shows "is_class P C  is_class P D"
(*<*)
using sub proof(induct)
  case step then show ?case
    by(auto simp:wf_cdecl_def is_class_def dest!:class_wf[OF _ wf] subcls1D)
qed simp
(*>*)

lemma is_class_xcpt:
  " C  sys_xcpts; wf_prog wf_md P   is_class P C"
(*<*)
by (fastforce intro!: map_of_SomeI
              simp add: wf_prog_def wf_syscls_def is_class_def class_def)
(*>*)


lemma subcls1_wfD:
assumes sub1: "P  C 1 D" and wf: "wf_prog wf_md P"
shows "D  C  (D,C)  (subcls1 P)+"
(*<*)
proof -
  obtain fs ms where "C  Object" and cls: "class P C = (D, fs, ms)"
    using subcls1D[OF sub1] by clarify
  then show ?thesis using wf class_wf[OF cls wf] r_into_trancl[OF sub1]
    by(force simp add: wf_cdecl_def reflcl_trancl [THEN sym]
             simp del: reflcl_trancl)
qed
(*>*)


lemma wf_cdecl_supD: 
  "wf_cdecl wf_md P (C,D,r); C  Object  is_class P D"
(*<*)by (auto simp: wf_cdecl_def)(*>*)


lemma subcls_asym:
  " wf_prog wf_md P; (C,D)  (subcls1 P)+   (D,C)  (subcls1 P)+"
(*<*)by(erule tranclE; fast dest!: subcls1_wfD intro: trancl_trans)(*>*)


lemma subcls_irrefl:
  " wf_prog wf_md P; (C,D)  (subcls1 P)+   C  D"
(*<*)by (erule trancl_trans_induct) (auto dest: subcls1_wfD subcls_asym)(*>*)


lemma acyclic_subcls1:
  "wf_prog wf_md P  acyclic (subcls1 P)"
(*<*)by (unfold acyclic_def) (fast dest: subcls_irrefl)(*>*)


lemma wf_subcls1:
  "wf_prog wf_md P  wf ((subcls1 P)¯)"
(*<*)
proof -
  assume wf: "wf_prog wf_md P"
  have "finite (subcls1 P)" by(rule finite_subcls1)
  then have fin': "finite ((subcls1 P)¯)" by(subst finite_converse)

  from wf have "acyclic (subcls1 P)" by(rule acyclic_subcls1)
  then have acyc': "acyclic ((subcls1 P)¯)" by (subst acyclic_converse)

  from fin' acyc' show ?thesis by (rule finite_acyclic_wf)
qed
(*>*)


lemma single_valued_subcls1:
  "wf_prog wf_md G  single_valued (subcls1 G)"
(*<*)
by(auto simp:wf_prog_def distinct_fst_def single_valued_def dest!:subcls1D)
(*>*)


lemma subcls_induct: 
  " wf_prog wf_md P; C. D. (C,D)  (subcls1 P)+  Q D  Q C   Q C"
(*<*)
  (is "?A  PROP ?P  _")
proof -
  assume p: "PROP ?P"
  assume ?A then have wf: "wf_prog wf_md P" by assumption
  have wf':"wf (((subcls1 P)+)¯)" using wf_trancl[OF wf_subcls1[OF wf]]
    by(simp only: trancl_converse)
  show ?thesis using wf_induct[where a = C and P = Q, OF wf' p] by simp
qed
(*>*)


lemma subcls1_induct_aux:
assumes "is_class P C" and wf: "wf_prog wf_md P" and QObj: "Q Object"
shows
 " C D fs ms.
     C  Object; is_class P C; class P C = Some (D,fs,ms) 
      wf_cdecl wf_md P (C,D,fs,ms)  P  C 1 D  is_class P D  Q D  Q C 
   Q C"
(*<*)
  (is "PROP ?P  _")
proof -
  assume p: "PROP ?P"
  have "class P C  None  Q C"
  proof(induct rule: subcls_induct[OF wf])
    case (1 C)
    have "class P C  None  Q C"
    proof(cases "C = Object")
      case True
      then show ?thesis using QObj by fast
    next
      case False
      assume nNone: "class P C  None"
      then have is_cls: "is_class P C" by(simp add: is_class_def)
      obtain D fs ms where cls: "class P C = (D, fs, ms)" using nNone by safe
      also have wfC: "wf_cdecl wf_md P (C, D, fs, ms)" by(rule class_wf[OF cls wf])
      moreover have D: "is_class P D" by(rule wf_cdecl_supD[OF wfC False])
      moreover have "P  C 1 D" by(rule subcls1I[OF cls False])
      moreover have "class P D  None" using D by(simp add: is_class_def)
      ultimately show ?thesis using 1 by (auto intro: p[OF False is_cls])
    qed
  then show "class P C  None  Q C" by simp
  qed
  thus ?thesis using assms by(unfold is_class_def) simp
qed
(*>*)

(* FIXME can't we prove this one directly?? *)
lemma subcls1_induct [consumes 2, case_names Object Subcls]:
  " wf_prog wf_md P; is_class P C; Q Object;
    C D. C  Object; P  C 1 D; is_class P D; Q D  Q C 
   Q C"
(*<*)by (erule (2) subcls1_induct_aux) blast(*>*)


lemma subcls_C_Object:
assumes "class": "is_class P C" and wf: "wf_prog wf_md P"
shows "P  C * Object"
(*<*)
using wf "class"
proof(induct rule: subcls1_induct)
  case Subcls
  then show ?case by(simp add: converse_rtrancl_into_rtrancl)
qed fast
(*>*)


lemma is_type_pTs:
assumes "wf_prog wf_md P" and "(C,S,fs,ms)  set P" and "(M,b,Ts,T,m)  set ms"
shows "set Ts  types P"
(*<*)
proof
  from assms have "wf_mdecl wf_md P C (M,b,Ts,T,m)" 
    by (unfold wf_prog_def wf_cdecl_def) auto
  hence "t  set Ts. is_type P t" by (unfold wf_mdecl_def) auto
  moreover fix t assume "t  set Ts"
  ultimately have "is_type P t" by blast
  thus "t  types P" ..
qed
(*>*)

lemma wf_supercls_distinct_app:
assumes wf:"wf_prog wf_md P"
  and nObj: "C  Object" and cls: "class P C = (D, fs, ms)"
  and super: "supercls_lst P (C#Cs)" and dist: "distinct (C#Cs)"
shows "distinct (D#C#Cs)"
proof -
  have "¬ P  D * C" using subcls1_wfD[OF subcls1I[OF cls nObj] wf]
    by (simp add: rtrancl_eq_or_trancl)
  then show ?thesis using assms by auto
qed


subsection‹ Well-formedness and method lookup ›

lemma sees_wf_mdecl:
assumes wf: "wf_prog wf_md P" and sees: "P  C sees M,b:TsT = m in D"
shows "wf_mdecl wf_md P D (M,b,Ts,T,m)"
(*<*)
using wf visible_method_exists[OF sees] proof(cases b)
qed (fastforce simp:wf_cdecl_def dest!:class_wf dest:map_of_SomeD)+
(*>*)

lemma sees_method_mono [rule_format (no_asm)]: 
assumes sub: "P  C' * C" and wf: "wf_prog wf_md P"
shows "D b Ts T m. P  C sees M,b:TsT = m in D 
     (D' Ts' T' m'. P  C' sees M,b:Ts'T' = m' in D'  P  Ts [≤] Ts'  P  T'  T)"
(*<*)
  (is "D b Ts T m. ?P C D b Ts T m  ?Q C' D b Ts T m")
proof(rule disjE[OF rtranclD[OF sub]])
  assume "C' = C"
  then show ?thesis using assms by fastforce
next
  assume "C'  C  (C', C)  (subcls1 P)+"
  then have neq: "C'  C" and subcls1: "(C', C)  (subcls1 P)+" by simp+
  show ?thesis proof(induct rule: trancl_trans_induct[OF subcls1])
    case (2 x y z)
    then have zy: "D b Ts T m. ?P z D b Ts T m  ?Q y D b Ts T m" by blast
    have "D b Ts T m. ?P z D b Ts T m  ?Q x D b Ts T m"
    proof -
      fix D b Ts T m assume P: "?P z D b Ts T m"
      then show "?Q x D b Ts T m" using zy[OF P] 2(2)
        by(fast elim: widen_trans widens_trans)
    qed
    then show ?case by blast
  next
    case (1 x y)
    have "D b Ts T m. ?P y D b Ts T m  ?Q x D b Ts T m"
    proof -
      fix D b Ts T m assume P: "?P y D b Ts T m"
      then obtain Mm where sees: "P  y sees_methods Mm" and
                           M: "Mm M = ((b, Ts, T, m), D)"
        by(clarsimp simp:Method_def)
      obtain fs ms where nObj: "x  Object" and
                         cls: "class P x = (y, fs, ms)"
        using subcls1D[OF 1] by clarsimp
      have x_meth: "P  x sees_methods Mm ++ (map_option (λm. (m, x))  map_of ms)"
        using sees_methods_rec[OF cls nObj sees] by simp
      show "?Q x D b Ts T m" proof(cases "map_of ms M")
        case None
        then have "m'. P  x sees M, b :  TsT = m' in D" using M x_meth
          by(fastforce simp add:Method_def map_add_def split:option.split)
        then show ?thesis by auto
      next
        case (Some a)
        then obtain b' Ts' T' m' where a: "a = (b',Ts',T',m')" by(cases a)
        then have "(m' Mm. P  y sees_methods Mm  Mm M = ((b, Ts, T, m'), D))
               b' = b  P  Ts [≤] Ts'  P  T'  T"
          using nObj class_wf[OF cls wf] map_of_SomeD[OF Some]
          by(clarsimp simp: wf_cdecl_def Method_def) fast
        then show ?thesis using Some a sees M x_meth
          by(fastforce simp:Method_def map_add_def split:option.split)
      qed
    qed
    then show ?case by simp
  qed
qed
(*>*)


lemma sees_method_mono2:
  " P  C' * C; wf_prog wf_md P;
     P  C sees M,b:TsT = m in D; P  C' sees M,b':Ts'T' = m' in D' 
   b = b'  P  Ts [≤] Ts'  P  T'  T"
(*<*)by(blast dest:sees_method_mono sees_method_fun)(*>*)

lemma mdecls_visible:
assumes wf: "wf_prog wf_md P" and "class": "is_class P C"
shows "D fs ms. class P C = Some(D,fs,ms)
          Mm. P  C sees_methods Mm  ((M,b,Ts,T,m)  set ms. Mm M = Some((b,Ts,T,m),C))"
(*<*)
using wf "class"
proof (induct rule:subcls1_induct)
  case Object
  with wf have dfst:"distinct_fst ms"
    by (unfold class_def wf_prog_def wf_cdecl_def) (fastforce dest:map_of_SomeD)
  with dfst have "distinct_fst ms"
    by(blast dest: distinct_fst_appendD)
  with Object show ?case by(fastforce intro!: sees_methods_Object map_of_SomeI)
next
  case Subcls
  with wf have dfst:"distinct_fst ms"
    by (unfold class_def wf_prog_def wf_cdecl_def) (fastforce dest:map_of_SomeD)
  with dfst have "distinct_fst ms"
    by(blast dest: distinct_fst_appendD)
  with Subcls show ?case
    by(fastforce elim:sees_methods_rec dest:subcls1D map_of_SomeI
                simp:is_class_def)
qed
(*>*)

lemma mdecl_visible:
assumes wf: "wf_prog wf_md P" and C: "(C,S,fs,ms)  set P" and  m: "(M,b,Ts,T,m)  set ms"
shows "P  C sees M,b:TsT = m in C"
(*<*)
proof -
  from wf C have "class": "class P C = Some (S,fs,ms)"
    by (auto simp add: wf_prog_def class_def is_class_def intro: map_of_SomeI)
  from "class" have "is_class P C" by(auto simp:is_class_def)                   
  with assms "class" show ?thesis
    by(bestsimp simp:Method_def dest:mdecls_visible)
qed
(*>*)


lemma Call_lemma:
assumes sees: "P  C sees M,b:TsT = m in D" and sub: "P  C' * C" and wf: "wf_prog wf_md P"
shows "D' Ts' T' m'.
       P  C' sees M,b:Ts'T' = m' in D'  P  Ts [≤] Ts'  P  T'  T  P  C' * D'
        is_type P T'  (Tset Ts'. is_type P T)  wf_md P D' (M,b,Ts',T',m')"
(*<*)
using assms sees_method_mono[OF sub wf sees]
by(fastforce intro:sees_method_decl_above dest:sees_wf_mdecl
             simp: wf_mdecl_def)
(*>*)


lemma wf_prog_lift:
  assumes wf: "wf_prog (λP C bd. A P C bd) P"
  and rule:
  "wf_md C M b Ts C T m bd.
   wf_prog wf_md P 
   P  C sees M,b:TsT = m in C 
   set Ts   types P 
   bd = (M,b,Ts,T,m) 
   A P C bd 
   B P C bd"
  shows "wf_prog (λP C bd. B P C bd) P"
(*<*)
proof -
  have "c. cset P  wf_cdecl A P c  wf_cdecl B P c"
  proof -
    fix c assume "cset P" and "wf_cdecl A P c"
    then show "wf_cdecl B P c"
     using rule[OF wf mdecl_visible[OF wf] is_type_pTs[OF wf]]
     by (auto simp: wf_cdecl_def wf_mdecl_def)
  qed
  then show ?thesis using wf by (clarsimp simp: wf_prog_def)
qed
(*>*)

lemma wf_sees_clinit:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a"
shows "m. P  C sees clinit,Static:[]  Void = m in C"
proof -
  from ex obtain D fs ms where "a = (D,fs,ms)" by(cases a)
  then have sP: "(C, D, fs, ms)  set P" using ex map_of_SomeD[of P C a] by(simp add: class_def)
  then have "wf_clinit ms" using assms by(unfold wf_prog_def wf_cdecl_def, auto)
  then obtain m where sm: "(clinit, Static, [], Void, m)  set ms" by (meson wf_clinit_def)
  then have "P  C sees clinit,Static:[]  Void = m in C"
    using mdecl_visible[OF wf sP sm] by simp
  then show ?thesis by(rule exI)
qed
(*>*)

lemma wf_sees_clinit1:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a"
and "P  C sees clinit,b:Ts  T = m in D"
shows "b = Static  Ts = []  T = Void  D = C"
proof -
  obtain m' where sees: "P  C sees clinit,Static:[]  Void = m' in C"
    using wf_sees_clinit[OF wf ex] by clarify
  then show ?thesis using sees wf by (meson assms(3) sees_method_fun)
qed

lemma wf_NonStatic_nclinit:
assumes wf: "wf_prog wf_md P" and meth: "P  C sees M,NonStatic:TsT=(mxs,mxl,ins,xt) in D"
shows "M  clinit"
proof -
  from sees_method_is_class[OF meth] obtain a where cls: "class P C = Some a"
    by(clarsimp simp: is_class_def)
  with wf wf_sees_clinit[OF wf cls]
   obtain m where "P  C sees clinit,Static:[]Void=m in C" by clarsimp
  with meth show ?thesis by(auto dest: sees_method_fun)
qed

subsection‹ Well-formedness and field lookup ›

lemma wf_Fields_Ex:
assumes wf: "wf_prog wf_md P" and "is_class P C"
shows "FDTs. P  C has_fields FDTs"
(*<*)
using assms proof(induct rule:subcls1_induct)
  case Object
  then show ?case using class_Object[OF wf]
    by(blast intro:has_fields_Object)
next
  case Subcls
  then show ?case by(blast intro:has_fields_rec dest:subcls1D)
qed
(*>*)


lemma has_fields_types:
  " P  C has_fields FDTs; (FD,b,T)  set FDTs; wf_prog wf_md P   is_type P T"
(*<*)
proof(induct rule:Fields.induct)
qed(fastforce dest!: class_wf simp: wf_cdecl_def wf_fdecl_def)+
(*>*)

lemma sees_field_is_type:
  " P  C sees F,b:T in D; wf_prog wf_md P   is_type P T"
(*<*)
  by (meson has_field_def has_fields_types has_visible_field map_of_SomeD)
(*>*)


lemma wf_syscls:
  "set SystemClasses  set P  wf_syscls P"
(*<*)
by (force simp: image_def SystemClasses_def wf_syscls_def sys_xcpts_def
                ObjectC_def NullPointerC_def ClassCastC_def OutOfMemoryC_def
                NoClassDefFoundC_def
                IncompatibleClassChangeC_def NoSuchFieldC_def NoSuchMethodC_def)
(*>*)


subsection‹ Well-formedness and subclassing ›

lemma wf_subcls_nCls:
assumes wf: "wf_prog wf_md P" and ns: "¬ is_class P C"
shows " P  D * D'; D  C   D'  C"
proof(induct rule: rtrancl.induct)
  case (rtrancl_into_rtrancl a b c)
  with ns show ?case by(clarsimp dest!: subcls1D wf_cdecl_supD[OF class_wf[OF _ wf]])
qed(simp)

lemma wf_subcls_nCls':
assumes wf: "wf_prog wf_md P" and ns: "¬is_class P C0"
shows "cd D'. cd  set P  ¬P  fst cd * C0"
proof -
  fix cd D' assume cd: "cd  set P"
  then have cls: "is_class P (fst cd)" using class_exists_equiv is_class_def by blast
  with wf_subcls_nCls[OF wf ns] ns show "¬P  fst cd * C0" by(cases "fst cd = D'", auto)
qed

lemma wf_nclass_nsub:
 " wf_prog wf_md P; is_class P C; ¬is_class P C'   ¬P  C * C'"
 by(rule notI, auto dest: wf_subcls_nCls[where C=C' and D=C])

lemma wf_sys_xcpt_nsub_Start:
assumes wf: "wf_prog wf_md P" and ns: "¬is_class P Start" and sx: "C  sys_xcpts"
shows "¬P  C * Start"
proof -
  have Cns: "C  Start" using Start_nsys_xcpts sx by clarsimp
  show ?thesis using wf_subcls_nCls[OF wf ns _ Cns] by auto
qed

end

Theory WWellForm

(*  Title:      JinjaDCI/J/WWellForm.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/WWellForm.thy by Tobias Nipkow
*)

section ‹ Weak well-formedness of Jinja programs ›

theory WWellForm imports "../Common/WellForm" Expr begin

definition wwf_J_mdecl :: "J_prog  cname  J_mb mdecl  bool"
where
  "wwf_J_mdecl P C    λ(M,b,Ts,T,(pns,body)).
 length Ts = length pns  distinct pns  ¬sub_RI body 
  (case b of
   NonStatic  this  set pns  fv body  {this}  set pns
 | Static  fv body  set pns)"

lemma wwf_J_mdecl_NonStatic[simp]:
  "wwf_J_mdecl P C (M,NonStatic,Ts,T,pns,body) =
  (length Ts = length pns  distinct pns  ¬sub_RI body  this  set pns  fv body  {this}  set pns)"
(*<*)by(simp add:wwf_J_mdecl_def)(*>*)

lemma wwf_J_mdecl_Static[simp]:
  "wwf_J_mdecl P C (M,Static,Ts,T,pns,body) =
  (length Ts = length pns  distinct pns  ¬sub_RI body  fv body  set pns)"
(*<*)by(simp add:wwf_J_mdecl_def)(*>*)

abbreviation
  wwf_J_prog :: "J_prog  bool" where
  "wwf_J_prog  wf_prog wwf_J_mdecl"


lemma sees_wwf_nsub_RI:
 " wwf_J_prog P; P  C sees M,b : TsT = (pns, body) in D   ¬sub_RI body"
apply(drule sees_wf_mdecl, simp)
apply(unfold wwf_J_mdecl_def wf_mdecl_def, simp)
done

end

Theory BigStep

(*  Title:      JinjaDCI/J/BigStep.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/BigStep.thy by Tobias Nipkow
*)

section ‹ Big Step Semantics ›

theory BigStep imports Expr State WWellForm begin

inductive
  eval :: "J_prog  expr  state  expr  state  bool"
          ("_  ((1_,/_) / (1_,/_))" [51,0,0,0,0] 81)
  and evals :: "J_prog  expr list  state  expr list  state  bool"
           ("_  ((1_,/_) [⇒]/ (1_,/_))" [51,0,0,0,0] 81)
  for P :: J_prog
where

  New:
  " sh C = Some (sfs, Done); new_Addr h = Some a;
     P  C has_fields FDTs; h' = h(ablank P C) 
   P  new C,(h,l,sh)  addr a,(h',l,sh)"

| NewFail:
  " sh C = Some (sfs, Done); new_Addr h = None; is_class P C  
  P  new C, (h,l,sh)  THROW OutOfMemory,(h,l,sh)"

| NewInit:
  " sfs. sh C = Some (sfs, Done); P  INIT C ([C],False)  unit,(h,l,sh)  Val v',(h',l',sh');
     new_Addr h' = Some a; P  C has_fields FDTs; h'' = h'(ablank P C) 
   P  new C,(h,l,sh)  addr a,(h'',l',sh')"

| NewInitOOM:
  " sfs. sh C = Some (sfs, Done); P  INIT C ([C],False)  unit,(h,l,sh)  Val v',(h',l',sh');
     new_Addr h' = None; is_class P C 
   P  new C,(h,l,sh)  THROW OutOfMemory,(h',l',sh')"

| NewInitThrow:
  " sfs. sh C = Some (sfs, Done); P  INIT C ([C],False)  unit,(h,l,sh)  throw a,s';
     is_class P C 
   P  new C,(h,l,sh)  throw a,s'"

| Cast:
  " P  e,s0  addr a,(h,l,sh); h a = Some(D,fs); P  D * C 
   P  Cast C e,s0  addr a,(h,l,sh)"

| CastNull:
  "P  e,s0  null,s1 
  P  Cast C e,s0  null,s1"

| CastFail:
  " P  e,s0 addr a,(h,l,sh); h a = Some(D,fs); ¬ P  D * C 
   P  Cast C e,s0  THROW ClassCast,(h,l,sh)"

| CastThrow:
  "P  e,s0  throw e',s1 
  P  Cast C e,s0  throw e',s1"

| Val:
  "P  Val v,s  Val v,s"

| BinOp:
  " P  e1,s0  Val v1,s1; P  e2,s1  Val v2,s2; binop(bop,v1,v2) = Some v 
   P  e1 «bop» e2,s0  Val v,s2"

| BinOpThrow1:
  "P  e1,s0  throw e,s1 
  P  e1 «bop» e2, s0  throw e,s1"

| BinOpThrow2:
  " P  e1,s0  Val v1,s1; P  e2,s1  throw e,s2 
   P  e1 «bop» e2,s0  throw e,s2"

| Var:
  "l V = Some v 
  P  Var V,(h,l,sh)  Val v,(h,l,sh)"

| LAss:
  " P  e,s0  Val v,(h,l,sh); l' = l(Vv) 
   P  V:=e,s0  unit,(h,l',sh)"

| LAssThrow:
  "P  e,s0  throw e',s1 
  P  V:=e,s0  throw e',s1"

| FAcc:
  " P  e,s0  addr a,(h,l,sh); h a = Some(C,fs);
     P  C has F,NonStatic:t in D;
     fs(F,D) = Some v 
   P  eF{D},s0  Val v,(h,l,sh)"

| FAccNull:
  "P  e,s0  null,s1 
  P  eF{D},s0  THROW NullPointer,s1"

| FAccThrow:
  "P  e,s0  throw e',s1 
  P  eF{D},s0  throw e',s1"

| FAccNone:
  " P  e,s0  addr a,(h,l,sh); h a = Some(C,fs);
    ¬(b t. P  C has F,b:t in D) 
   P  eF{D},s0  THROW NoSuchFieldError,(h,l,sh)"

| FAccStatic:
  " P  e,s0  addr a,(h,l,sh); h a = Some(C,fs);
    P  C has F,Static:t in D 
   P  eF{D},s0  THROW IncompatibleClassChangeError,(h,l,sh)"

| SFAcc:
  " P  C has F,Static:t in D;
     sh D = Some (sfs,Done);
     sfs F = Some v 
   P  CsF{D},(h,l,sh)  Val v,(h,l,sh)"

| SFAccInit:
  " P  C has F,Static:t in D;
     sfs. sh D = Some (sfs,Done); P  INIT D ([D],False)  unit,(h,l,sh)  Val v',(h',l',sh');
     sh' D = Some (sfs,i);
     sfs F = Some v 
   P  CsF{D},(h,l,sh)  Val v,(h',l',sh')"

| SFAccInitThrow:
  " P  C has F,Static:t in D;
     sfs. sh D = Some (sfs,Done); P  INIT D ([D],False)  unit,(h,l,sh)  throw a,s' 
   P  CsF{D},(h,l,sh)  throw a,s'"

| SFAccNone:
  " ¬(b t. P  C has F,b:t in D) 
   P  CsF{D},s  THROW NoSuchFieldError,s"

| SFAccNonStatic:
  " P  C has F,NonStatic:t in D 
   P  CsF{D},s  THROW IncompatibleClassChangeError,s"

| FAss:
  " P  e1,s0  addr a,s1; P  e2,s1  Val v,(h2,l2,sh2);
     h2 a = Some(C,fs); P  C has F,NonStatic:t in D;
     fs' = fs((F,D)v); h2' = h2(a(C,fs')) 
   P  e1F{D}:=e2,s0  unit,(h2',l2,sh2)"

| FAssNull:
  " P  e1,s0  null,s1;  P  e2,s1  Val v,s2  
  P  e1F{D}:=e2,s0  THROW NullPointer,s2"

| FAssThrow1:
  "P  e1,s0  throw e',s1 
  P  e1F{D}:=e2,s0  throw e',s1"

| FAssThrow2:
  " P  e1,s0  Val v,s1; P  e2,s1  throw e',s2 
   P  e1F{D}:=e2,s0  throw e',s2"

| FAssNone:
  " P  e1,s0  addr a,s1; P  e2,s1  Val v,(h2,l2,sh2);
     h2 a = Some(C,fs); ¬(b t. P  C has F,b:t in D) 
   P  e1F{D}:=e2,s0  THROW NoSuchFieldError,(h2,l2,sh2)"

| FAssStatic:
  " P  e1,s0  addr a,s1; P  e2,s1  Val v,(h2,l2,sh2);
     h2 a = Some(C,fs); P  C has F,Static:t in D 
   P  e1F{D}:=e2,s0  THROW IncompatibleClassChangeError,(h2,l2,sh2)"

| SFAss:
  " P  e2,s0  Val v,(h1,l1,sh1);
     P  C has F,Static:t in D;
     sh1 D = Some(sfs,Done); sfs' = sfs(Fv); sh1' = sh1(D(sfs',Done)) 
   P  CsF{D}:=e2,s0  unit,(h1,l1,sh1')"

| SFAssInit:
  " P  e2,s0  Val v,(h1,l1,sh1);
     P  C has F,Static:t in D;
     sfs. sh1 D = Some(sfs,Done); P  INIT D ([D],False)  unit,(h1,l1,sh1)  Val v',(h',l',sh');
     sh' D = Some(sfs,i);
     sfs' = sfs(Fv); sh'' = sh'(D(sfs',i)) 
   P  CsF{D}:=e2,s0  unit,(h',l',sh'')"

| SFAssInitThrow:
  " P  e2,s0  Val v,(h1,l1,sh1);
     P  C has F,Static:t in D;
     sfs. sh1 D = Some(sfs,Done); P  INIT D ([D],False)  unit,(h1,l1,sh1)  throw a,s' 
   P  CsF{D}:=e2,s0  throw a,s'"

| SFAssThrow:
  "P  e2,s0  throw e',s2
   P  CsF{D}:=e2,s0  throw e',s2"

| SFAssNone:
  " P  e2,s0  Val v,(h2,l2,sh2);
    ¬(b t. P  C has F,b:t in D) 
   P  CsF{D}:=e2,s0  THROW NoSuchFieldError,(h2,l2,sh2)"

| SFAssNonStatic:
  " P  e2,s0  Val v,(h2,l2,sh2);
    P  C has F,NonStatic:t in D 
   P  CsF{D}:=e2,s0  THROW IncompatibleClassChangeError,(h2,l2,sh2)"

| CallObjThrow:
  "P  e,s0  throw e',s1 
  P  eM(ps),s0  throw e',s1"

| CallParamsThrow:
  " P  e,s0  Val v,s1; P  es,s1 [⇒] map Val vs @ throw ex # es',s2 
    P  eM(es),s0  throw ex,s2"

| CallNull:
  " P  e,s0  null,s1;  P  ps,s1 [⇒] map Val vs,s2 
   P  eM(ps),s0  THROW NullPointer,s2"

| CallNone:
  " P  e,s0  addr a,s1;  P  ps,s1 [⇒] map Val vs,(h2,l2,sh2);
     h2 a = Some(C,fs); ¬(b Ts T m D. P  C sees M,b:TsT = m in D) 
   P  eM(ps),s0  THROW NoSuchMethodError,(h2,l2,sh2)"

| CallStatic:
  " P  e,s0  addr a,s1;  P  ps,s1 [⇒] map Val vs,(h2,l2,sh2);
     h2 a = Some(C,fs); P  C sees M,Static:TsT = m in D 
   P  eM(ps),s0  THROW IncompatibleClassChangeError,(h2,l2,sh2)"

| Call:
  " P  e,s0  addr a,s1;  P  ps,s1 [⇒] map Val vs,(h2,l2,sh2);
     h2 a = Some(C,fs); P  C sees M,NonStatic:TsT = (pns,body) in D;
     length vs = length pns;  l2' = [thisAddr a, pns[↦]vs];
     P  body,(h2,l2',sh2)  e',(h3,l3,sh3) 
   P  eM(ps),s0  e',(h3,l2,sh3)"

| SCallParamsThrow:
  " P  es,s0 [⇒] map Val vs @ throw ex # es',s2 
    P  CsM(es),s0  throw ex,s2"

| SCallNone:
  " P  ps,s0 [⇒] map Val vs,s2;
     ¬(b Ts T m D. P  C sees M,b:TsT = m in D) 
   P  CsM(ps),s0  THROW NoSuchMethodError,s2"

| SCallNonStatic:
  " P  ps,s0 [⇒] map Val vs,s2;
     P  C sees M,NonStatic:TsT = m in D 
   P  CsM(ps),s0  THROW IncompatibleClassChangeError,s2"

| SCallInitThrow:
  " P  ps,s0 [⇒] map Val vs,(h1,l1,sh1);
     P  C sees M,Static:TsT = (pns,body) in D;
     sfs. sh1 D = Some(sfs,Done); M  clinit;
     P  INIT D ([D],False)  unit,(h1,l1,sh1)  throw a,s' 
   P  CsM(ps),s0  throw a,s'"

| SCallInit:
  " P  ps,s0 [⇒] map Val vs,(h1,l1,sh1);
     P  C sees M,Static:TsT = (pns,body) in D;
     sfs. sh1 D = Some(sfs,Done); M  clinit;
     P  INIT D ([D],False)  unit,(h1,l1,sh1)  Val v',(h2,l2,sh2);
     length vs = length pns;  l2' = [pns[↦]vs];
     P  body,(h2,l2',sh2)  e',(h3,l3,sh3) 
   P  CsM(ps),s0  e',(h3,l2,sh3)"

| SCall:
  " P  ps,s0 [⇒] map Val vs,(h2,l2,sh2);
     P  C sees M,Static:TsT = (pns,body) in D;
     sh2 D = Some(sfs,Done)  (M = clinit  sh2 D = Some(sfs,Processing));
     length vs = length pns;  l2' = [pns[↦]vs];
     P  body,(h2,l2',sh2)  e',(h3,l3,sh3) 
   P  CsM(ps),s0  e',(h3,l2,sh3)"

| Block:
  "P  e0,(h0,l0(V:=None),sh0)  e1,(h1,l1,sh1) 
  P  {V:T; e0},(h0,l0,sh0)  e1,(h1,l1(V:=l0 V),sh1)"

| Seq:
  " P  e0,s0  Val v,s1; P  e1,s1  e2,s2 
   P  e0;;e1,s0  e2,s2"

| SeqThrow:
  "P  e0,s0  throw e,s1 
  P  e0;;e1,s0  throw e,s1"

| CondT:
  " P  e,s0  true,s1; P  e1,s1  e',s2 
   P  if (e) e1 else e2,s0  e',s2"

| CondF:
  " P  e,s0  false,s1; P  e2,s1  e',s2 
   P  if (e) e1 else e2,s0  e',s2"

| CondThrow:
  "P  e,s0  throw e',s1 
  P  if (e) e1 else e2, s0  throw e',s1"

| WhileF:
  "P  e,s0  false,s1 
  P  while (e) c,s0  unit,s1"

| WhileT:
  " P  e,s0  true,s1; P  c,s1  Val v1,s2; P  while (e) c,s2  e3,s3 
   P  while (e) c,s0  e3,s3"

| WhileCondThrow:
  "P  e,s0  throw e',s1 
  P  while (e) c,s0  throw e',s1"

| WhileBodyThrow:
  " P  e,s0  true,s1; P  c,s1  throw e',s2
   P  while (e) c,s0  throw e',s2"

| Throw:
  "P  e,s0  addr a,s1 
  P  throw e,s0  Throw a,s1"

| ThrowNull:
  "P  e,s0  null,s1 
  P  throw e,s0  THROW NullPointer,s1"

| ThrowThrow:
  "P  e,s0  throw e',s1 
  P  throw e,s0  throw e',s1"

| Try:
  "P  e1,s0  Val v1,s1 
  P  try e1 catch(C V) e2,s0  Val v1,s1"

| TryCatch:
  " P  e1,s0  Throw a,(h1,l1,sh1);  h1 a = Some(D,fs);  P  D * C;
     P  e2,(h1,l1(VAddr a),sh1)  e2',(h2,l2,sh2) 
   P  try e1 catch(C V) e2,s0  e2',(h2,l2(V:=l1 V),sh2)"

| TryThrow:
  " P  e1,s0  Throw a,(h1,l1,sh1);  h1 a = Some(D,fs);  ¬ P  D * C 
   P  try e1 catch(C V) e2,s0  Throw a,(h1,l1,sh1)"

| Nil:
  "P  [],s [⇒] [],s"

| Cons:
  " P  e,s0  Val v,s1; P  es,s1 [⇒] es',s2 
   P  e#es,s0 [⇒] Val v # es',s2"

| ConsThrow:
  "P  e, s0  throw e', s1 
  P  e#es, s0 [⇒] throw e' # es, s1"

― ‹ init rules ›

| InitFinal:
  "P  e,s  e',s'  P  INIT C (Nil,b)  e,s  e',s'"

| InitNone:
  " sh C = None; P  INIT C' (C#Cs,False)  e,(h,l,sh(C  (sblank P C, Prepared)))  e',s' 
   P  INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"

| InitDone:
  " sh C = Some(sfs,Done); P  INIT C' (Cs,True)  e,(h,l,sh)  e',s' 
   P  INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"

| InitProcessing:
  " sh C = Some(sfs,Processing); P  INIT C' (Cs,True)  e,(h,l,sh)  e',s' 
   P  INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"

― ‹ note that @{text RI} will mark all classes in the list Cs with the Error flag ›
| InitError:
  " sh C = Some(sfs,Error);
     P  RI (C, THROW NoClassDefFoundError);Cs  e,(h,l,sh)  e',s' 
   P  INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"

| InitObject:
  " sh C = Some(sfs,Prepared);
     C = Object;
     sh' = sh(C  (sfs,Processing));
     P  INIT C' (C#Cs,True)  e,(h,l,sh')  e',s' 
   P  INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"

| InitNonObject:
  " sh C = Some(sfs,Prepared);
     C  Object;
     class P C = Some (D,r);
     sh' = sh(C  (sfs,Processing));
     P  INIT C' (D#C#Cs,False)  e,(h,l,sh')  e',s' 
   P  INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"

| InitRInit:
  "P  RI (C,Csclinit([]));Cs  e,(h,l,sh)  e',s'
   P  INIT C' (C#Cs,True)  e,(h,l,sh)  e',s'"

| RInit:
  " P  e',s  Val v, (h',l',sh');
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Done));
     C' = last(C#Cs);
     P  INIT C' (Cs,True)  e, (h',l',sh'')  e1,s1 
   P  RI (C,e');Cs  e,s  e1,s1"

| RInitInitFail:
  " P  e',s  throw a, (h',l',sh');
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Error));
     P  RI (D,throw a);Cs  e, (h',l',sh'')  e1,s1 
   P  RI (C,e');D#Cs  e,s  e1,s1"

| RInitFailFinal:
  " P  e',s  throw a, (h',l',sh');
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Error)) 
   P  RI (C,e');Nil  e,s  throw a, (h',l',sh'')"

(*<*)
lemmas eval_evals_induct = eval_evals.induct [split_format (complete)]
  and eval_evals_inducts = eval_evals.inducts [split_format (complete)]

inductive_cases eval_cases [cases set]:
 "P  new C,s  e',s'"
 "P  Cast C e,s  e',s'"
 "P  Val v,s  e',s'"
 "P  e1 «bop» e2,s  e',s'"
 "P  Var v,s  e',s'"
 "P  V:=e,s  e',s'"
 "P  eF{D},s  e',s'"
 "P  CsF{D},s  e',s'"
 "P  e1F{D}:=e2,s  e',s'"
 "P  CsF{D}:=e2,s  e',s'"
 "P  eM(es),s  e',s'"
 "P  CsM(es),s  e',s'"
 "P  {V:T;e1},s  e',s'"
 "P  e1;;e2,s  e',s'"
 "P  if (e) e1 else e2,s  e',s'"
 "P  while (b) c,s  e',s'"
 "P  throw e,s  e',s'"
 "P  try e1 catch(C V) e2,s  e',s'"
 "P  INIT C (Cs,b)  e,s  e',s'"
 "P  RI (C,e);Cs  e0,s  e',s'"
 
inductive_cases evals_cases [cases set]:
 "P  [],s [⇒] e',s'"
 "P  e#es,s [⇒] e',s'"
(*>*) 

subsection "Final expressions"

lemma eval_final: "P  e,s  e',s'  final e'"
 and evals_final: "P  es,s [⇒] es',s'  finals es'"
(*<*)by(induct rule:eval_evals.inducts, simp_all)(*>*)

text‹ Only used later, in the small to big translation, but is already a
good sanity check: ›

lemma eval_finalId:  "final e  P  e,s  e,s"
(*<*)by (erule finalE) (iprover intro: eval_evals.intros)+(*>*)

lemma eval_final_same: " P  e,s  e',s'; final e   e = e'  s = s'"
(*<*)by(auto elim!: finalE eval_cases)(*>*)

lemma eval_finalsId:
assumes finals: "finals es" shows "P  es,s [⇒] es,s"
(*<*)
  using finals
proof (induct es type: list)
  case Nil show ?case by (rule eval_evals.intros)
next
  case (Cons e es)
  have hyp: "finals es  P  es,s [⇒] es,s"
   and finals: "finals (e # es)" by fact+
  show "P  e # es,s [⇒] e # es,s"
  proof cases
    assume "final e"
    thus ?thesis
    proof (cases rule: finalE)
      fix v assume e: "e = Val v"
      have "P  Val v,s  Val v,s" by (simp add: eval_finalId)
      moreover from finals e have "P  es,s [⇒] es,s" by(fast intro:hyp)
      ultimately have "P  Val v#es,s [⇒] Val v#es,s"
        by (rule eval_evals.intros)
      with e show ?thesis by simp
    next
      fix a assume e: "e = Throw a"
      have "P  Throw a,s  Throw a,s" by (simp add: eval_finalId)
      hence "P  Throw a#es,s [⇒] Throw a#es,s" by (rule eval_evals.intros)
      with e show ?thesis by simp
    qed
  next
    assume "¬ final e"
    with not_finals_ConsI finals have False by blast
    thus ?thesis ..
  qed
qed
(*>*)

lemma evals_finals_same:
assumes finals: "finals es"
shows "P  es,s [⇒] es',s'  es = es'  s = s'"
  using finals
proof (induct es arbitrary: es' type: list)
  case Nil then show ?case using evals_cases(1) by blast
next
  case (Cons e es)
  have IH: "es'. P  es,s [⇒] es',s'  finals es  es = es'  s = s'"
   and step: "P  e # es,s [⇒] es',s'" and finals: "finals (e # es)" by fact+
  then obtain e' es'' where es': "es' = e'#es''" by (meson Cons.prems(1) evals_cases(2))
  have fe: "final e" using finals not_finals_ConsI by auto
  show ?case
  proof(rule evals_cases(2)[OF step])
    fix v s1 es1 assume es1: "es' = Val v # es1"
      and estep: "P  e,s  Val v,s1" and esstep: "P  es,s1 [⇒] es1,s'"
    then have "e = Val v" using eval_final_same fe by auto
    then have "finals es" using es' not_finals_ConsI2 finals by blast
    then show ?thesis using es' IH estep esstep es1 eval_final_same fe by blast
  next
    fix e' assume es1: "es' = throw e' # es" and estep: "P  e,s  throw e',s'"
    then have "e = throw e'" using eval_final_same fe by auto
    then show ?thesis using es' estep es1 eval_final_same fe by blast
  qed
qed
(*>*)

subsection "Property preservation"

lemma evals_length: "P  es,s [⇒] es',s'  length es = length es'"
 by(induct es arbitrary:es' s s', auto elim: evals_cases)

corollary evals_empty: "P  es,s [⇒] es',s'  (es = []) = (es' = [])"
 by(drule evals_length, fastforce)

(****)

theorem eval_hext: "P  e,(h,l,sh)  e',(h',l',sh')  h  h'"
and evals_hext:  "P  es,(h,l,sh) [⇒] es',(h',l',sh')  h  h'"
(*<*)
proof (induct rule: eval_evals_inducts)
  case New thus ?case
    by(fastforce intro!: hext_new intro:LeastI simp:new_Addr_def
                split:if_split_asm simp del:fun_upd_apply)
next
  case NewInit thus ?case
    by (meson hext_new hext_trans new_Addr_SomeD)
next
  case FAss thus ?case
    by(auto simp:sym[THEN hext_upd_obj] simp del:fun_upd_apply
            elim!: hext_trans)
qed (auto elim!: hext_trans)
(*>*)


lemma eval_lcl_incr: "P  e,(h0,l0,sh0)  e',(h1,l1,sh1)  dom l0  dom l1"
 and evals_lcl_incr: "P  es,(h0,l0,sh0) [⇒] es',(h1,l1,sh1)  dom l0  dom l1"
(*<*)
proof (induct rule: eval_evals_inducts)
  case BinOp show ?case by(rule subset_trans)(rule BinOp.hyps)+
next
  case Call thus ?case
    by(simp del: fun_upd_apply)
next
  case Seq show ?case by(rule subset_trans)(rule Seq.hyps)+
next
  case CondT show ?case by(rule subset_trans)(rule CondT.hyps)+
next
  case CondF show ?case by(rule subset_trans)(rule CondF.hyps)+
next
  case WhileT thus ?case by(blast)
next
  case TryCatch thus ?case by(clarsimp simp:dom_def split:if_split_asm) blast
next
  case Cons show ?case by(rule subset_trans)(rule Cons.hyps)+
next
  case Block thus ?case by(auto simp del:fun_upd_apply)
qed auto
(*>*)

lemma
shows init_ri_same_loc: "P  e,(h,l,sh)  e',(h',l',sh')
    (C Cs b M a. e = INIT C (Cs,b)  unit  e = CsM([])  e = RI (C,Throw a) ; Cs  unit
           e = RI (C,Csclinit([])) ; Cs  unit
            l = l')"
  and "P  es,(h,l,sh) [⇒] es',(h',l',sh')  True"
proof(induct rule: eval_evals_inducts)
  case (RInitInitFail e h l sh a')
  then show ?case using eval_final[of _ _ _ "throw a'"]
     by(fastforce dest: eval_final_same[of _ "Throw a"])
next
  case RInitFailFinal then show ?case by(auto dest: eval_final_same)
qed(auto dest: evals_cases eval_cases(17) eval_final_same)

lemma init_same_loc: "P  INIT C (Cs,b)  unit,(h,l,sh)  e',(h',l',sh')  l = l'"
 by(simp add: init_ri_same_loc)

(****)

lemma assumes wf: "wwf_J_prog P"
shows eval_proc_pres': "P  e,(h,l,sh)  e',(h',l',sh')
   not_init C e  sfs. sh C = (sfs, Processing)  sfs'. sh' C = (sfs', Processing)"
  and evals_proc_pres': "P  es,(h,l,sh) [⇒] es',(h',l',sh')
   not_inits C es  sfs. sh C = (sfs, Processing)  sfs'. sh' C = (sfs', Processing)"
(*<*)
proof(induct rule:eval_evals_inducts)
  case Call then show ?case using sees_wwf_nsub_RI[OF wf Call.hyps(6)] nsub_RI_not_init by auto
next
  case (SCallInit ps h l sh vs h1 l1 sh1 C' M Ts T pns body D v' h2 l2 sh2 l2' e' h3 l3 sh3)
  then show ?case
    using SCallInit sees_wwf_nsub_RI[OF wf SCallInit.hyps(3)] nsub_RI_not_init[of body] by auto
next
  case SCall then show ?case using sees_wwf_nsub_RI[OF wf SCall.hyps(3)] nsub_RI_not_init by auto
next
  case (InitNone sh C1 C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
  case (InitDone sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
  case (InitProcessing sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
  case (InitError sh C1 sfs Cs h l e' a a b C') then show ?case by(cases "C = C1") auto
next
  case (InitObject sh C1 sfs sh' C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
  case (InitNonObject sh C1 sfs D a b sh' C' Cs h l e' a a b)
  then show ?case by(cases "C = C1") auto
next
  case (RInit e a a b v h' l' sh' C sfs i sh'' C' Cs e1 a a b) then show ?case by(cases Cs, auto)
next
  case (RInitInitFail e h l sh a h' l' sh' C1 sfs i sh'' D Cs e1 h1 l1 sh1)
  then show ?case using eval_final by fastforce
qed(auto)

(************************************************)

subsection‹Init Elimination rules›

lemma init_NilE:
assumes init: "P  INIT C (Nil,b)  unit,s  e',s'"
shows "e' = unit  s' = s"
proof(rule eval_cases(19)[OF init]) ― ‹ Init › qed(auto dest: eval_final_same)

lemma init_ProcessingE:
assumes shC: "sh C = (sfs, Processing)"
 and init: "P  INIT C ([C],False)  unit,(h,l,sh)  e',s'"
shows "e' = unit  s' = (h,l,sh)"
proof(rule eval_cases(19)[OF init]) ― ‹ Init ›
  fix sha Ca sfs Cs ha la
  assume "(h, l, sh) = (ha, la, sha)" and "sha Ca = (sfs, Processing)"
   and "P  INIT C (Cs,True)  unit,(ha, la, sha)  e',s'" and "[C] = Ca # Cs"
  then show ?thesis using init_NilE by simp
next
  fix sha sfs Cs ha la
  assume "(h, l, sh) = (ha, la, sha)" and "sha Object = (sfs, Prepared)"
     and "[C] = Object # Cs"
  then show ?thesis using shC by clarsimp
qed(auto simp: assms)


lemma rinit_throwE:
"P  RI (C,throw e) ; Cs  e0,s  e',s'
    a st. e' = throw a  P  throw e,s  throw a,st"
proof(induct Cs arbitrary: C e s)
  case Nil
  then show ?case
  proof(rule eval_cases(20)) ― ‹ RI ›
    fix v h' l' sh' assume "P  throw e,s  Val v,(h', l', sh')"
    then show ?case using eval_cases(17) by blast
  qed(auto)
next
  case (Cons C' Cs')
  show ?case using Cons.prems(1)
  proof(rule eval_cases(20)) ― ‹ RI ›
    fix v h' l' sh' assume "P  throw e,s  Val v,(h', l', sh')"
    then show ?case using eval_cases(17) by blast
  next
    fix a h' l' sh' sfs i D Cs''
    assume e''step: "P  throw e,s  throw a,(h', l', sh')"
       and shC: "sh' C = (sfs, i)"
       and riD: "P  RI (D,throw a) ; Cs''  e0,(h', l', sh'(C  (sfs, Error)))  e',s'"
       and "C' # Cs' = D # Cs''"
    then show ?thesis using Cons.hyps eval_final eval_final_same by blast
  qed(simp)
qed

lemma rinit_ValE:
assumes ri: "P  RI (C,e) ; Cs  unit,s  Val v',s'"
shows "v'' s''. P  e,s  Val v'',s''"
proof(rule eval_cases(20)[OF ri]) ― ‹ RI ›
  fix a h' l' sh' sfs i D Cs'
  assume "P  RI (D,throw a) ; Cs'  unit,(h', l', sh'(C  (sfs, Error)))  Val v',s'"
  then show ?thesis using rinit_throwE by blast
qed(auto)

subsection "Some specific evaluations"

lemma lass_val_of_eval:
 " lass_val_of e = a; P  e,(h, l, sh)  e',(h', l', sh') 
   e' = unit  h' = h  l' = l(fst asnd a)  sh' = sh"
 by(drule lass_val_of_spec, auto elim: eval.cases)

lemma eval_throw_nonVal:
assumes eval: "P  e,s  throw a,s'"
shows "val_of e = None"
proof(cases "val_of e")
  case (Some v) show ?thesis using eval by(auto simp: val_of_spec[OF Some] intro: eval.cases)
qed(simp)

lemma eval_throw_nonLAss:
assumes eval: "P  e,s  throw a,s'"
shows "lass_val_of e = None"
proof(cases "lass_val_of e")
  case (Some v) show ?thesis using eval by(auto simp: lass_val_of_spec[OF Some] intro: eval.cases)
qed(simp)

end

Theory DefAss

(*  Title:      JinjaDCI/J/DefAss.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/DefAss.thy by Tobias Nipkow
*)

section ‹ Definite assignment ›

theory DefAss imports BigStep begin

subsection "Hypersets"

type_synonym 'a hyperset = "'a set option"

definition hyperUn :: "'a hyperset  'a hyperset  'a hyperset"   (infixl "" 65)
where
  "A  B    case A of None  None
                 | A  (case B of None  None | B  A  B)"

definition hyperInt :: "'a hyperset  'a hyperset  'a hyperset"   (infixl "" 70)
where
  "A  B    case A of None  B
                 | A  (case B of None  A | B  A  B)"

definition hyperDiff1 :: "'a hyperset  'a  'a hyperset"   (infixl "" 65)
where
  "A  a    case A of None  None | A  A - {a}"

definition hyper_isin :: "'a  'a hyperset  bool"   (infix "∈∈" 50)
where
  "a ∈∈ A    case A of None  True | A  a  A"

definition hyper_subset :: "'a hyperset  'a hyperset  bool"   (infix "" 50)
where
  "A  B    case B of None  True
                 | B  (case A of None  False | A  A  B)"

lemmas hyperset_defs =
 hyperUn_def hyperInt_def hyperDiff1_def hyper_isin_def hyper_subset_def

lemma [simp]: "{}  A = A    A  {} = A"
(*<*)by(simp add:hyperset_defs)(*>*)

lemma [simp]: "A  B = A  B  A  a = A - {a}"
(*<*)by(simp add:hyperset_defs)(*>*)

lemma [simp]: "None  A = None  A  None = None"
(*<*)by(simp add:hyperset_defs)(*>*)

lemma [simp]: "a ∈∈ None  None  a = None"
(*<*)by(simp add:hyperset_defs)(*>*)

lemma hyper_isin_union: "x ∈∈ A  x ∈∈ A  B"
 by(case_tac B, auto simp: hyper_isin_def)

lemma hyperUn_assoc: "(A  B)  C = A  (B  C)"
(*<*)by(simp add:hyperset_defs Un_assoc)(*>*)

lemma hyper_insert_comm: "A  {a} = {a}  A  A  ({a}  B) = {a}  (A  B)"
(*<*)by(simp add:hyperset_defs)(*>*)

lemma hyper_comm: "A  B = B  A  A  B  C = B  A  C"
apply(case_tac A, simp, case_tac B, simp)
apply(case_tac C, simp add: Un_commute)
apply(simp add: Un_left_commute Un_commute)
done

subsection "Definite assignment"

primrec
  𝒜  :: "'a exp  'a hyperset"
  and 𝒜s :: "'a exp list  'a hyperset"
where
  "𝒜 (new C) = {}"
| "𝒜 (Cast C e) = 𝒜 e"
| "𝒜 (Val v) = {}"
| "𝒜 (e1 «bop» e2) = 𝒜 e1  𝒜 e2"
| "𝒜 (Var V) = {}"
| "𝒜 (LAss V e) = {V}  𝒜 e"
| "𝒜 (eF{D}) = 𝒜 e"
| "𝒜 (CsF{D}) = {}"
| "𝒜 (e1F{D}:=e2) = 𝒜 e1  𝒜 e2"
| "𝒜 (CsF{D}:=e2) = 𝒜 e2"
| "𝒜 (eM(es)) = 𝒜 e  𝒜s es"
| "𝒜 (CsM(es)) = 𝒜s es"
| "𝒜 ({V:T; e}) = 𝒜 e  V"
| "𝒜 (e1;;e2) = 𝒜 e1  𝒜 e2"
| "𝒜 (if (e) e1 else e2) =  𝒜 e  (𝒜 e1  𝒜 e2)"
| "𝒜 (while (b) e) = 𝒜 b"
| "𝒜 (throw e) = None"
| "𝒜 (try e1 catch(C V) e2) = 𝒜 e1  (𝒜 e2  V)"
| "𝒜 (INIT C (Cs,b)  e) = {}"
| "𝒜 (RI (C,e);Cs  e') = 𝒜 e"

| "𝒜s ([]) = {}"
| "𝒜s (e#es) = 𝒜 e  𝒜s es"

primrec
  𝒟  :: "'a exp  'a hyperset  bool"
  and 𝒟s :: "'a exp list  'a hyperset  bool"
where
  "𝒟 (new C) A = True"
| "𝒟 (Cast C e) A = 𝒟 e A"
| "𝒟 (Val v) A = True"
| "𝒟 (e1 «bop» e2) A = (𝒟 e1 A  𝒟 e2 (A  𝒜 e1))"
| "𝒟 (Var V) A = (V ∈∈ A)"
| "𝒟 (LAss V e) A = 𝒟 e A"
| "𝒟 (eF{D}) A = 𝒟 e A"
| "𝒟 (CsF{D}) A = True"
| "𝒟 (e1F{D}:=e2) A = (𝒟 e1 A  𝒟 e2 (A  𝒜 e1))"
| "𝒟 (CsF{D}:=e2) A = 𝒟 e2 A"
| "𝒟 (eM(es)) A = (𝒟 e A  𝒟s es (A  𝒜 e))"
| "𝒟 (CsM(es)) A = 𝒟s es A"
| "𝒟 ({V:T; e}) A = 𝒟 e (A  V)"
| "𝒟 (e1;;e2) A = (𝒟 e1 A  𝒟 e2 (A  𝒜 e1))"
| "𝒟 (if (e) e1 else e2) A =
  (𝒟 e A  𝒟 e1 (A  𝒜 e)  𝒟 e2 (A  𝒜 e))"
| "𝒟 (while (e) c) A = (𝒟 e A  𝒟 c (A  𝒜 e))"
| "𝒟 (throw e) A = 𝒟 e A"
| "𝒟 (try e1 catch(C V) e2) A = (𝒟 e1 A  𝒟 e2 (A  {V}))"
| "𝒟 (INIT C (Cs,b)  e) A = 𝒟 e A"
| "𝒟 (RI (C,e);Cs  e') A = (𝒟 e A  𝒟 e' A)"

| "𝒟s ([]) A = True"
| "𝒟s (e#es) A = (𝒟 e A  𝒟s es (A  𝒜 e))"

lemma As_map_Val[simp]: "𝒜s (map Val vs) = {}"
(*<*)by (induct vs) simp_all(*>*)

lemma D_append[iff]: "A. 𝒟s (es @ es') A = (𝒟s es A  𝒟s es' (A  𝒜s es))"
(*<*)by (induct es type:list) (auto simp:hyperUn_assoc)(*>*)


lemma A_fv: "A. 𝒜 e = A  A  fv e"
and  "A. 𝒜s es = A  A  fvs es"
(*<*)
apply(induct e and es rule: 𝒜.induct 𝒜s.induct)
apply (simp_all add:hyperset_defs)
apply blast+
done
(*>*)


lemma sqUn_lem: "A  A'  A  B  A'  B"
(*<*)by(simp add:hyperset_defs) blast(*>*)

lemma diff_lem: "A  A'  A  b  A'  b"
(*<*)by(simp add:hyperset_defs) blast(*>*)

(* This order of the premises avoids looping of the simplifier *)
lemma D_mono: "A A'. A  A'  𝒟 e A  𝒟 (e::'a exp) A'"
and Ds_mono: "A A'. A  A'  𝒟s es A  𝒟s (es::'a exp list) A'"
(*<*)
apply(induct e and es rule: 𝒟.induct 𝒟s.induct)
apply simp
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply (fastforce simp add:hyperset_defs)
apply simp
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp apply (iprover dest:diff_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
done
(*>*)

(* And this is the order of premises preferred during application: *)
lemma D_mono': "𝒟 e A  A  A'  𝒟 e A'"
and Ds_mono': "𝒟s es A  A  A'  𝒟s es A'"
(*<*)by(blast intro:D_mono, blast intro:Ds_mono)(*>*)


lemma Ds_Vals: "𝒟s (map Val vs) A" by(induct vs, auto)

end

Theory Conform

(*  Title:      JinjaDCI/Common/Conform.thy

    Author:     David von Oheimb, Tobias Nipkow, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/Conform.thy by David von Oheimb and Tobias Nipkow
*)

section ‹ Conformance Relations for Type Soundness Proofs ›

theory Conform
imports Exceptions
begin

definition conf :: "'m prog  heap  val  ty  bool"   ("_,_  _ :≤ _"  [51,51,51,51] 50)
where
  "P,h  v :≤ T  
  T'. typeofh v = Some T'  P  T'  T"

definition oconf :: "'m prog  heap  obj  bool"   ("_,_  _ " [51,51,51] 50)
where
  "P,h  obj   
  let (C,fs) = obj in F D T. P  C has F,NonStatic:T in D 
  (v. fs(F,D) = Some v  P,h  v :≤ T)"

definition soconf :: "'m prog  heap  cname  sfields  bool"   ("_,_,_ s _ " [51,51,51,51] 50)
where
  "P,h,C s sfs   
  F T. P  C has F,Static:T in C 
  (v. sfs F = Some v  P,h  v :≤ T)"

definition hconf :: "'m prog  heap  bool"  ("_  _ " [51,51] 50)
where
  "P  h   
  (a obj. h a = Some obj  P,h  obj )  preallocated h"

definition shconf :: "'m prog  heap  sheap  bool"  ("_,_ s _ " [51,51,51] 50)
where
  "P,h s sh   
  (C sfs i. sh C = Some(sfs,i)  P,h,C s sfs )"

definition lconf :: "'m prog  heap  (vname  val)  (vname  ty)  bool"   ("_,_  _ '(:≤') _" [51,51,51,51] 50)
where
  "P,h  l (:≤) E  
  V v. l V = Some v  (T. E V = Some T  P,h  v :≤ T)"

abbreviation
  confs :: "'m prog  heap  val list  ty list  bool" 
             ("_,_  _ [:≤] _" [51,51,51,51] 50) where
  "P,h  vs [:≤] Ts  list_all2 (conf P h) vs Ts"


subsection‹ Value conformance @{text":≤"}

lemma conf_Null [simp]: "P,h  Null :≤ T  =  P  NT  T"
(*<*)by (simp (no_asm) add: conf_def)(*>*)

lemma typeof_conf[simp]: "typeofh v = Some T  P,h  v :≤ T"
(*<*)by (induct v) (auto simp: conf_def)(*>*)

lemma typeof_lit_conf[simp]: "typeof v = Some T  P,h  v :≤ T"
(*<*)by (rule typeof_conf[OF typeof_lit_typeof])(*>*)

lemma defval_conf[simp]: "P,h  default_val T :≤ T"
(*<*)by (cases T) (auto simp: conf_def)(*>*)

lemma conf_upd_obj: "h a = Some(C,fs)  (P,h(a(C,fs'))  x :≤ T) = (P,h  x :≤ T)"
(*<*)by (rule val.induct) (auto simp:conf_def fun_upd_apply)(*>*)

lemma conf_widen: "P,h  v :≤ T  P  T  T'  P,h  v :≤ T'"
(*<*)by (induct v) (auto intro: widen_trans simp: conf_def)(*>*)

lemma conf_hext: "h  h'  P,h  v :≤ T  P,h'  v :≤ T"
(*<*)by (induct v) (auto dest: hext_objD simp: conf_def)(*>*)

lemma conf_ClassD: "P,h  v :≤ Class C 
  v = Null  (a obj T. v = Addr a   h a = Some obj  obj_ty obj = T   P  T  Class C)"
(*<*)by(induct v) (auto simp: conf_def)(*>*)

lemma conf_NT [iff]: "P,h  v :≤ NT = (v = Null)"
(*<*)by (auto simp add: conf_def)(*>*)

lemma non_npD: " v  Null; P,h  v :≤ Class C 
   a C' fs. v = Addr a  h a = Some(C',fs)  P  C' * C"
(*<*)by (auto dest: conf_ClassD)(*>*)


subsection‹ Value list conformance @{text"[:≤]"}

lemma confs_widens [trans]: "P,h  vs [:≤] Ts; P  Ts [≤] Ts'  P,h  vs [:≤] Ts'"
(*<*)by(auto intro: list_all2_trans conf_widen)(*>*)

lemma confs_rev: "P,h  rev s [:≤] t = (P,h  s [:≤] rev t)"
(*<*)by (simp add: list_all2_rev1)(*>*)

lemma confs_conv_map:
  "Ts'. P,h  vs [:≤] Ts' = (Ts. map typeofh vs = map Some Ts  P  Ts [≤] Ts')"
(*<*)
proof(induct vs)
  case (Cons a vs)
  then show ?case by(case_tac Ts') (auto simp add:conf_def)
qed simp
(*>*)

lemma confs_hext: "P,h  vs [:≤] Ts  h  h'  P,h'  vs [:≤] Ts"
(*<*)by (erule list_all2_mono, erule conf_hext, assumption)(*>*)

lemma confs_Cons2: "P,h  xs [:≤] y#ys = (z zs. xs = z#zs  P,h  z :≤ y  P,h  zs [:≤] ys)"
(*<*)by (rule list_all2_Cons2)(*>*)


subsection "Object conformance"

lemma oconf_hext: "P,h  obj   h  h'  P,h'  obj "
(*<*)by (fastforce elim:conf_hext simp: oconf_def)(*>*)

lemma oconf_blank:
 "P  C has_fields FDTs  P,h  blank P C "
(*<*)
by(fastforce dest: has_fields_fun
             simp: has_field_def oconf_def blank_def init_fields_def
                   map_of_filtered_SomeD)
(*>*)

lemma oconf_fupd [intro?]:
  " P  C has F,NonStatic:T in D; P,h  v :≤ T; P,h  (C,fs)   
   P,h  (C, fs((F,D)v)) "
(*<*)by (auto dest: has_fields_fun simp add: oconf_def has_field_def fun_upd_apply)(*>*)

(*<*)
lemmas oconf_new = oconf_hext [OF _ hext_new]
lemmas oconf_upd_obj = oconf_hext [OF _ hext_upd_obj]
(*>*)

subsection "Static object conformance"

lemma soconf_hext: "P,h,C s obj   h  h'  P,h',C s obj "
(*<*)by (fastforce elim:conf_hext simp:soconf_def)(*>*)

lemma soconf_sblank:
 "P  C has_fields FDTs  P,h,C s sblank P C "
(*<*)
proof -
  let ?sfs = "sblank P C"
  assume FDTs: "P  C has_fields FDTs"
  then have "F T. P  C has F,Static:T in C
                  v. ?sfs F = Some v  P,h  v :≤ T"
  proof -
    fix F T assume has: "P  C has F,Static:T in C"
    with has_fields_fun[OF FDTs] have map: "map_of FDTs (F, C) = (Static, T)"
      by(clarsimp simp: has_field_def)
    then have "map_of (map (λ((F, D), b, T). (F, default_val T))
          (filter (λ((F, D), b, T). (case ((F, D), b, T) of (x, xa)
                (case x of (F, D)  λ(b, T). b = Static) xa)  D = C) FDTs)) F
         = default_val T"
     by(rule map_of_remove_filtered_SomeD[where P = "default_val"
               and Q = "λ((F, D), b, T). b = Static"]) simp
    with FDTs show "v. ?sfs F = Some v  P,h  v :≤ T"
      by(clarsimp simp: sblank_def init_sfields_def)
  qed
  then show ?thesis by(simp add: soconf_def)
qed
(*>*)

lemma soconf_fupd [intro?]:
  " P  C has F,Static:T in C; P,h  v :≤ T; P,h,C s sfs   
   P,h,C s sfs(Fv) "
(*<*)by (auto dest: has_fields_fun simp add: fun_upd_apply soconf_def has_field_def)(*>*)

(*<*)
lemmas soconf_new = soconf_hext [OF _ hext_new]
lemmas soconf_upd_obj = soconf_hext [OF _ hext_upd_obj]
(*>*)

subsection "Heap conformance"

lemma hconfD: " P  h ; h a = Some obj   P,h  obj "
(*<*)by (unfold hconf_def) fast(*>*)

lemma hconf_new: " P  h ; h a = None; P,h  obj    P  h(aobj) "
(*<*)by (unfold hconf_def) (auto intro: oconf_new preallocated_new)(*>*)

lemma hconf_upd_obj: " P  h; h a = Some(C,fs); P,h  (C,fs')   P  h(a(C,fs'))"
(*<*)by (unfold hconf_def) (auto intro: oconf_upd_obj preallocated_upd_obj)(*>*)


subsection "Class statics conformance"

lemma shconfD: " P,h s sh ; sh C = Some(sfs,i)   P,h,C s sfs "
(*<*)by (unfold shconf_def) fast(*>*)

lemma shconf_upd_obj: " P,h s sh ; P,h,C s sfs'  
  P,h s sh(C(sfs',i'))"
(*<*)by (unfold shconf_def) (auto intro: soconf_upd_obj preallocated_upd_obj)(*>*)

lemma shconf_hnew: " P,h s sh ; h a = None   P,h(aobj) s sh "
(*<*)by (unfold shconf_def) (auto intro: soconf_new preallocated_new)(*>*)

lemma shconf_hupd_obj: " P,h s sh ; h a = Some(C,fs)   P,h(a(C,fs')) s sh "
(*<*)by (unfold shconf_def) (auto intro: soconf_upd_obj preallocated_upd_obj)(*>*)

subsection "Local variable conformance"

lemma lconf_hext: " P,h  l (:≤) E; h  h'   P,h'  l (:≤) E"
(*<*)by (unfold lconf_def) (fast elim: conf_hext)(*>*)

lemma lconf_upd:
  " P,h  l (:≤) E; P,h  v :≤ T; E V = Some T   P,h  l(Vv) (:≤) E"
(*<*)by (unfold lconf_def) auto(*>*)

lemma lconf_empty[iff]: "P,h  Map.empty (:≤) E"
(*<*)by(simp add:lconf_def)(*>*)

lemma lconf_upd2: "P,h  l (:≤) E; P,h  v :≤ T  P,h  l(Vv) (:≤) E(VT)"
(*<*)by(simp add:lconf_def)(*>*)


end

Theory SmallStep

(*  Title:      JinjaDCI/J/SmallStep.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/SmallStep.thy by Tobias Nipkow
*)

section ‹ Small Step Semantics ›

theory SmallStep
imports Expr State WWellForm
begin

fun blocks :: "vname list * ty list * val list * expr  expr"
where
 "blocks(V#Vs, T#Ts, v#vs, e) = {V:T := Val v; blocks(Vs,Ts,vs,e)}"
|"blocks([],[],[],e) = e"

lemmas blocks_induct = blocks.induct[split_format (complete)]

lemma [simp]:
  " size vs = size Vs; size Ts = size Vs   fv(blocks(Vs,Ts,vs,e)) = fv e - set Vs"
(*<*)
by (induct rule:blocks_induct) auto
(*>*)


lemma sub_RI_blocks_body[iff]: "length vs = length pns  length Ts = length pns
  sub_RI (blocks (pns, Ts, vs, body))  sub_RI body"
proof(induct pns arbitrary: Ts vs)
  case Nil then show ?case by simp
next
  case Cons then show ?case by(cases vs; cases Ts) auto
qed


definition assigned :: "'a  'a exp  bool"
where
  "assigned V e    v e'. e = (V := Val v;; e')"

― ‹ expression is okay to go the right side of @{text INIT} or @{text "RI ←"}
 or to have indicator Boolean be True (in latter case, given that class is
 also verified initialized) ›
fun icheck :: "'m prog  cname  'a exp  bool" where
"icheck P C' (new C) = (C' = C)" |
"icheck P D' (CsF{D}) = ((D' = D)  (T. P  C has F,Static:T in D))" |
"icheck P D' (CsF{D}:=(Val v)) = ((D' = D)  (T. P  C has F,Static:T in D))" |
"icheck P D (CsM(es)) = ((vs. es = map Val vs)  (Ts T m. P  C sees M,Static:TsT = m in D))" |
"icheck P _ _ = False"

lemma nicheck_SFAss_nonVal: "val_of e2 = None  ¬icheck P C' (CsF{D} := (e2::'a exp))"
 by(rule notI, cases e2, auto)

inductive_set
  red  :: "J_prog  ((expr × state × bool) × (expr × state × bool)) set"
  and reds  :: "J_prog  ((expr list × state × bool) × (expr list × state × bool)) set"
  and red' :: "J_prog  expr  state  bool  expr  state  bool  bool"
          ("_  ((1_,/_,/_) / (1_,/_,/_))" [51,0,0,0,0,0,0] 81)
  and reds' :: "J_prog  expr list  state  bool  expr list  state  bool  bool"
          ("_  ((1_,/_,/_) [→]/ (1_,/_,/_))" [51,0,0,0,0,0,0] 81)
  for P :: J_prog
where

  "P  e,s,b  e',s',b'  ((e,s,b), e',s',b')  red P"
| "P  es,s,b [→] es',s',b'  ((es,s,b), es',s',b')  reds P"

| RedNew:
  " new_Addr h = Some a; P  C has_fields FDTs; h' = h(ablank P C) 
   P  new C, (h,l,sh), True  addr a, (h',l,sh), False"

| RedNewFail:
  " new_Addr h = None; is_class P C  
  P  new C, (h,l,sh), True  THROW OutOfMemory, (h,l,sh), False"

| NewInitDoneRed:
  "sh C = Some (sfs, Done) 
  P  new C, (h,l,sh), False  new C, (h,l,sh), True"

| NewInitRed:
  " sfs. sh C = Some (sfs, Done); is_class P C 
   P  new C,(h,l,sh),False  INIT C ([C],False)  new C,(h,l,sh),False"

| CastRed:
  "P  e,s,b  e',s',b' 
  P  Cast C e, s, b  Cast C e', s', b'"

| RedCastNull:
  "P  Cast C null, s, b  null,s,b"

| RedCast:
 " h a = Some(D,fs); P  D * C 
   P  Cast C (addr a), (h,l,sh), b  addr a, (h,l,sh), b"

| RedCastFail:
  " h a = Some(D,fs); ¬ P  D * C 
   P  Cast C (addr a), (h,l,sh), b  THROW ClassCast, (h,l,sh), b"

| BinOpRed1:
  "P  e,s,b  e',s',b' 
  P  e «bop» e2, s, b  e' «bop» e2, s', b'"

| BinOpRed2:
  "P  e,s,b  e',s',b' 
  P  (Val v1) «bop» e, s, b  (Val v1) «bop» e', s', b'"

| RedBinOp:
  "binop(bop,v1,v2) = Some v 
  P  (Val v1) «bop» (Val v2), s, b  Val v,s,b"

| RedVar:
  "l V = Some v 
  P  Var V,(h,l,sh),b  Val v,(h,l,sh),b"

| LAssRed:
  "P  e,s,b  e',s',b' 
  P  V:=e,s,b  V:=e',s',b'"

| RedLAss:
  "P  V:=(Val v), (h,l,sh), b  unit, (h,l(Vv),sh), b"

| FAccRed:
  "P  e,s,b  e',s',b' 
  P  eF{D}, s, b  e'F{D}, s', b'"

| RedFAcc:
  " h a = Some(C,fs); fs(F,D) = Some v;
     P  C has F,NonStatic:t in D 
   P  (addr a)F{D}, (h,l,sh), b  Val v,(h,l,sh),b"

| RedFAccNull:
  "P  nullF{D}, s, b  THROW NullPointer, s, b"

| RedFAccNone:
  " h a = Some(C,fs); ¬(b t. P  C has F,b:t in D) 
   P  (addr a)F{D},(h,l,sh),b  THROW NoSuchFieldError,(h,l,sh),b"

| RedFAccStatic:
  " h a = Some(C,fs); P  C has F,Static:t in D 
   P  (addr a)F{D},(h,l,sh),b  THROW IncompatibleClassChangeError,(h,l,sh),b"

| RedSFAcc:
  " P  C has F,Static:t in D;
     sh D = Some (sfs,i);
     sfs F = Some v 
   P  CsF{D},(h,l,sh),True  Val v,(h,l,sh),False"

| SFAccInitDoneRed:
  " P  C has F,Static:t in D;
     sh D = Some (sfs,Done) 
   P  CsF{D},(h,l,sh),False  CsF{D},(h,l,sh),True"

| SFAccInitRed:
  " P  C has F,Static:t in D;
     sfs. sh D = Some (sfs,Done) 
   P  CsF{D},(h,l,sh),False  INIT D ([D],False)  CsF{D},(h,l,sh),False"

| RedSFAccNone:
  "¬(b t. P  C has F,b:t in D)
   P  CsF{D},(h,l,sh),b  THROW NoSuchFieldError,(h,l,sh),False"

| RedSFAccNonStatic:
  "P  C has F,NonStatic:t in D
   P  CsF{D},(h,l,sh),b  THROW IncompatibleClassChangeError,(h,l,sh),False"

| FAssRed1:
  "P  e,s,b  e',s',b' 
  P  eF{D}:=e2, s, b  e'F{D}:=e2, s', b'"

| FAssRed2:
  "P  e,s,b  e',s',b' 
  P  Val vF{D}:=e, s, b  Val vF{D}:=e', s', b'"

| RedFAss:
  " P  C has F,NonStatic:t in D; h a = Some(C,fs)  
  P  (addr a)F{D}:=(Val v), (h,l,sh), b  unit, (h(a  (C,fs((F,D)  v))),l,sh), b"

| RedFAssNull:
  "P  nullF{D}:=Val v, s, b  THROW NullPointer, s, b"

| RedFAssNone:
  " h a = Some(C,fs); ¬(b t. P  C has F,b:t in D) 
   P  (addr a)F{D}:=(Val v),(h,l,sh),b  THROW NoSuchFieldError,(h,l,sh),b"

| RedFAssStatic:
  " h a = Some(C,fs); P  C has F,Static:t in D 
   P  (addr a)F{D}:=(Val v),(h,l,sh),b  THROW IncompatibleClassChangeError,(h,l,sh),b"

| SFAssRed:
  "P  e,s,b  e',s',b' 
  P  CsF{D}:=e, s, b  CsF{D}:=e', s', b'"

| RedSFAss:
  " P  C has F,Static:t in D;
     sh D = Some(sfs,i);
     sfs' = sfs(Fv); sh' = sh(D(sfs',i)) 
   P  CsF{D}:=(Val v),(h,l,sh),True  unit,(h,l,sh'),False"

| SFAssInitDoneRed:
  " P  C has F,Static:t in D;
     sh D = Some(sfs,Done) 
   P  CsF{D}:=(Val v),(h,l,sh),False  CsF{D}:=(Val v),(h,l,sh),True"

| SFAssInitRed:
  " P  C has F,Static:t in D;
     sfs. sh D = Some(sfs,Done) 
   P  CsF{D}:=(Val v),(h,l,sh),False  INIT D ([D],False) CsF{D}:=(Val v),(h,l,sh),False"

| RedSFAssNone:
  "¬(b t. P  C has F,b:t in D)
   P  CsF{D}:=(Val v),s,b  THROW NoSuchFieldError,s,False"

| RedSFAssNonStatic:
  "P  C has F,NonStatic:t in D
   P  CsF{D}:=(Val v),s,b  THROW IncompatibleClassChangeError,s,False"

| CallObj:
  "P  e,s,b  e',s',b' 
  P  eM(es),s,b  e'M(es),s',b'"

| CallParams:
  "P  es,s,b [→] es',s',b' 
  P  (Val v)M(es),s,b  (Val v)M(es'),s',b'"

| RedCall:
  " h a = Some(C,fs); P  C sees M,NonStatic:TsT = (pns,body) in D; size vs = size pns; size Ts = size pns 
   P  (addr a)M(map Val vs), (h,l,sh), b  blocks(this#pns, Class D#Ts, Addr a#vs, body), (h,l,sh), b"

| RedCallNull:
  "P  nullM(map Val vs),s,b  THROW NullPointer,s,b"

| RedCallNone:
  " h a = Some(C,fs); ¬(b Ts T m D. P  C sees M,b:TsT = m in D) 
   P  (addr a)M(map Val vs),(h,l,sh),b  THROW NoSuchMethodError,(h,l,sh),b"

| RedCallStatic:
  " h a = Some(C,fs); P  C sees M,Static:TsT = m in D 
   P  (addr a)M(map Val vs),(h,l,sh),b  THROW IncompatibleClassChangeError,(h,l,sh),b"

| SCallParams:
  "P  es,s,b [→] es',s',b' 
  P  CsM(es),s,b  CsM(es'),s',b'"

| RedSCall:
  " P  C sees M,Static:TsT = (pns,body) in D;
     length vs = length pns; size Ts = size pns 
   P  CsM(map Val vs),s,True  blocks(pns, Ts, vs, body), s, False"

| SCallInitDoneRed:
  " P  C sees M,Static:TsT = (pns,body) in D;
     sh D = Some(sfs,Done)  (M = clinit  sh D = Some(sfs,Processing)) 
   P  CsM(map Val vs),(h,l,sh), False  CsM(map Val vs),(h,l,sh), True"

| SCallInitRed:
  " P  C sees M,Static:TsT = (pns,body) in D;
     sfs. sh D = Some(sfs,Done); M  clinit 
   P  CsM(map Val vs),(h,l,sh), False  INIT D ([D],False)  CsM(map Val vs),(h,l,sh),False"

| RedSCallNone:
  " ¬(b Ts T m D. P  C sees M,b:TsT = m in D) 
   P  CsM(map Val vs),s,b  THROW NoSuchMethodError,s,False"

| RedSCallNonStatic:
  " P  C sees M,NonStatic:TsT = m in D 
   P  CsM(map Val vs),s,b  THROW IncompatibleClassChangeError,s,False"

| BlockRedNone:
  " P  e, (h,l(V:=None),sh), b  e', (h',l',sh'), b'; l' V = None; ¬ assigned V e 
   P  {V:T; e}, (h,l,sh), b  {V:T; e'}, (h',l'(V := l V),sh'), b'"

| BlockRedSome:
  " P  e, (h,l(V:=None),sh), b  e', (h',l',sh'), b'; l' V = Some v;¬ assigned V e 
   P  {V:T; e}, (h,l,sh), b  {V:T := Val v; e'}, (h',l'(V := l V),sh'), b'"

| InitBlockRed:
  " P  e, (h,l(Vv),sh), b  e', (h',l',sh'), b'; l' V = Some v' 
   P  {V:T := Val v; e}, (h,l,sh), b  {V:T := Val v'; e'}, (h',l'(V := l V),sh'), b'"

| RedBlock:
  "P  {V:T; Val u}, s, b  Val u, s, b"

| RedInitBlock:
  "P  {V:T := Val v; Val u}, s, b  Val u, s, b"

| SeqRed:
  "P  e,s,b  e',s',b' 
  P  e;;e2, s, b  e';;e2, s', b'"

| RedSeq:
  "P  (Val v);;e2, s, b  e2, s, b"

| CondRed:
  "P  e,s,b  e',s',b' 
  P  if (e) e1 else e2, s, b  if (e') e1 else e2, s', b'"

| RedCondT:
  "P  if (true) e1 else e2, s, b  e1, s, b"

| RedCondF:
  "P  if (false) e1 else e2, s, b  e2, s, b"

| RedWhile:
  "P  while(b) c, s, b'  if(b) (c;;while(b) c) else unit, s, b'"

| ThrowRed:
  "P  e,s,b  e',s',b' 
  P  throw e, s, b  throw e', s', b'"

| RedThrowNull:
  "P  throw null, s, b  THROW NullPointer, s, b"

| TryRed:
  "P  e,s,b  e',s',b' 
  P  try e catch(C V) e2, s, b  try e' catch(C V) e2, s', b'"

| RedTry:
  "P  try (Val v) catch(C V) e2, s, b  Val v, s, b"

| RedTryCatch:
  " hp s a = Some(D,fs); P  D * C 
   P  try (Throw a) catch(C V) e2, s, b  {V:Class C := addr a; e2}, s, b"

| RedTryFail:
  " hp s a = Some(D,fs); ¬ P  D * C 
   P  try (Throw a) catch(C V) e2, s, b  Throw a, s, b"

| ListRed1:
  "P  e,s,b  e',s',b' 
  P  e#es,s,b [→] e'#es,s',b'"

| ListRed2:
  "P  es,s,b [→] es',s',b' 
  P  Val v # es,s,b [→] Val v # es',s',b'"

― ‹Initialization procedure›

| RedInit:
  "¬sub_RI e  P  INIT C (Nil,b)  e,s,b'  e,s,icheck P C e"

| InitNoneRed:
  "sh C = None
   P  INIT C' (C#Cs,False)  e,(h,l,sh),b  INIT C' (C#Cs,False)  e,(h,l,sh(C  (sblank P C, Prepared))),b"

| RedInitDone:
  "sh C = Some(sfs,Done)
   P  INIT C' (C#Cs,False)  e,(h,l,sh),b  INIT C' (Cs,True)  e,(h,l,sh),b"

| RedInitProcessing:
  "sh C = Some(sfs,Processing)
   P  INIT C' (C#Cs,False)  e,(h,l,sh),b  INIT C' (Cs,True)  e,(h,l,sh),b"

| RedInitError:
  "sh C = Some(sfs,Error)
   P  INIT C' (C#Cs,False)  e,(h,l,sh),b  RI (C,THROW NoClassDefFoundError);Cs  e,(h,l,sh),b"

| InitObjectRed:
  " sh C = Some(sfs,Prepared);
     C = Object;
     sh' = sh(C  (sfs,Processing)) 
   P  INIT C' (C#Cs,False)  e,(h,l,sh),b  INIT C' (C#Cs,True)  e,(h,l,sh'),b"

| InitNonObjectSuperRed:
  " sh C = Some(sfs,Prepared);
     C  Object;
     class P C = Some (D,r);
     sh' = sh(C  (sfs,Processing)) 
   P  INIT C' (C#Cs,False)  e,(h,l,sh),b  INIT C' (D#C#Cs,False)  e,(h,l,sh'),b"

| RedInitRInit:
  "P  INIT C' (C#Cs,True)  e,(h,l,sh),b  RI (C,Csclinit([]));Cs  e,(h,l,sh),b"

| RInitRed:
  "P  e,s,b  e',s',b' 
  P  RI (C,e);Cs  e0, s, b  RI (C,e');Cs  e0, s', b'"

| RedRInit:
  " sh C = Some (sfs, i);
     sh' = sh(C  (sfs,Done));
     C' = last(C#Cs)  
  P  RI (C, Val v);Cs  e, (h,l,sh), b  INIT C' (Cs,True)  e, (h,l,sh'), b"

― ‹Exception propagation›

| CastThrow: "P  Cast C (throw e), s, b  throw e, s, b"
| BinOpThrow1: "P  (throw e) «bop» e2, s, b  throw e, s, b"
| BinOpThrow2: "P  (Val v1) «bop» (throw e), s, b  throw e, s, b"
| LAssThrow: "P  V:=(throw e), s, b  throw e, s, b"
| FAccThrow: "P  (throw e)F{D}, s, b  throw e, s, b"
| FAssThrow1: "P  (throw e)F{D}:=e2, s, b  throw e, s, b"
| FAssThrow2: "P  Val vF{D}:=(throw e), s, b  throw e, s, b"
| SFAssThrow: "P  CsF{D}:=(throw e), s, b  throw e, s, b"
| CallThrowObj: "P  (throw e)M(es), s, b  throw e, s, b"
| CallThrowParams: " es = map Val vs @ throw e # es'   P  (Val v)M(es), s, b  throw e, s, b"
| SCallThrowParams: " es = map Val vs @ throw e # es'   P  CsM(es), s, b  throw e, s, b"
| BlockThrow: "P  {V:T; Throw a}, s, b  Throw a, s, b"
| InitBlockThrow: "P  {V:T := Val v; Throw a}, s, b  Throw a, s, b"
| SeqThrow: "P  (throw e);;e2, s, b  throw e, s, b"
| CondThrow: "P  if (throw e) e1 else e2, s, b  throw e, s, b"
| ThrowThrow: "P  throw(throw e), s, b  throw e, s, b"
| RInitInitThrow: " sh C = Some(sfs,i); sh' = sh(C  (sfs,Error))  
  P  RI (C,Throw a);D#Cs  e,(h,l,sh),b  RI (D,Throw a);Cs  e,(h,l,sh'),b"
| RInitThrow: " sh C = Some(sfs, i); sh' = sh(C  (sfs,Error))  
  P  RI (C,Throw a);Nil  e,(h,l,sh),b  Throw a,(h,l,sh'),b"
(*<*)
lemmas red_reds_induct = red_reds.induct [split_format (complete)]
  and red_reds_inducts = red_reds.inducts [split_format (complete)]

inductive_cases [elim!]:
 "P  V:=e,s,b  e',s',b'"
 "P  e1;;e2,s,b  e',s',b'"
(*>*)

subsection‹ The reflexive transitive closure ›

abbreviation
  Step :: "J_prog  expr  state  bool  expr  state  bool  bool"
          ("_  ((1_,/_,/_) →*/ (1_,/_,/_))" [51,0,0,0,0,0,0] 81)
  where "P  e,s,b →* e',s',b'  ((e,s,b), e',s',b')  (red P)*"

abbreviation
  Steps :: "J_prog  expr list  state  bool  expr list  state  bool  bool"
          ("_  ((1_,/_,/_) [→]*/ (1_,/_,/_))" [51,0,0,0,0,0,0] 81)
  where "P  es,s,b [→]* es',s',b'  ((es,s,b), es',s',b')  (reds P)*"


lemmas converse_rtrancl_induct3 =
  converse_rtrancl_induct [of "(ax, ay, az)" "(bx, by, bz)", split_format (complete),
    consumes 1, case_names refl step]

lemma converse_rtrancl_induct_red[consumes 1]:
assumes "P  e,(h,l,sh),b →* e',(h',l',sh'),b'"
and "e h l sh b. R e h l sh b e h l sh b"
and "e0 h0 l0 sh0 b0 e1 h1 l1 sh1 b1 e' h' l' sh' b'.
        P  e0,(h0,l0,sh0),b0  e1,(h1,l1,sh1),b1; R e1 h1 l1 sh1 b1 e' h' l' sh' b' 
    R e0 h0 l0 sh0 b0 e' h' l' sh' b'"
shows "R e h l sh b e' h' l' sh' b'"
(*<*)
proof -
  { fix s s'
    assume reds: "P  e,s,b →* e',s',b'"
       and base: "e s b. R e (hp s) (lcl s) (shp s) b e (hp s) (lcl s) (shp s) b"
       and red1: "e0 s0 b0 e1 s1 b1 e' s' b'.
            P  e0,s0,b0  e1,s1,b1; R e1 (hp s1) (lcl s1) (shp s1) b1 e' (hp s') (lcl s') (shp s') b' 
            R e0 (hp s0) (lcl s0) (shp s0) b0 e' (hp s') (lcl s') (shp s') b'"
    from reds have "R e (hp s) (lcl s) (shp s) b e' (hp s') (lcl s') (shp s') b'"
    proof (induct rule:converse_rtrancl_induct3)
      case refl show ?case by(rule base)
    next
      case step
      thus ?case by(blast intro:red1)
    qed
    }
  with assms show ?thesis by fastforce
qed
(*>*)


subsection‹Some easy lemmas›

lemma [iff]: "¬ P  [],s,b [→] es',s',b'"
(*<*)by(blast elim: reds.cases)(*>*)

lemma [iff]: "¬ P  Val v,s,b  e',s',b'"
(*<*)by(fastforce elim: red.cases)(*>*)

lemma val_no_step: "val_of e = v  ¬ P  e,s,b  e',s',b'"
(*<*)by(drule val_of_spec, simp)(*>*)

lemma [iff]: "¬ P  Throw a,s,b  e',s',b'"
(*<*)by(fastforce elim: red.cases)(*>*)


lemma map_Vals_no_step [iff]: "¬ P  map Val vs,s,b [→] es',s',b'"
(*<*)
apply(induct vs arbitrary: es', simp)
apply(rule notI)
apply(erule reds.cases, auto)
done
(*>*)

lemma vals_no_step: "map_vals_of es = vs  ¬ P  es,s,b [→] es',s',b'"
(*<*)by(drule map_vals_of_spec, simp)(*>*)

lemma vals_throw_no_step [iff]: "¬ P  map Val vs @ Throw a # es,s,b [→] es',s',b'"
(*<*)
apply(induct vs arbitrary: es', auto)
apply(erule reds.cases, auto)
apply(erule reds.cases, auto)
done
(*>*)

lemma lass_val_of_red:
 " lass_val_of e = a; P  e,(h, l, sh),b  e',(h', l', sh'),b' 
   e' = unit  h' = h  l' = l(fst asnd a)  sh' = sh  b = b'"
(*<*)by(drule lass_val_of_spec, auto)(*>*)


lemma final_no_step [iff]: "final e  ¬ P  e,s,b  e',s',b'"
(*<*)by(erule finalE, simp+)(*>*)

lemma finals_no_step [iff]: "finals es  ¬ P  es,s,b [→] es',s',b'"
(*<*)by(erule finalsE, simp+)(*>*)

lemma reds_final_same:
"P  e,s,b →* e',s',b'  final e  e = e'  s = s'  b = b'"
proof(induct rule:converse_rtrancl_induct3)
  case refl show ?case by simp
next
  case (step e0 s0 b0 e1 s1 b1) show ?case
  proof(rule finalE[OF step.prems(1)])
    fix v assume "e0 = Val v" then show ?thesis using step by simp
  next
    fix a assume "e0 = Throw a" then show ?thesis using step by simp
  qed
qed

lemma reds_throw:
"P  e,s,b →* e',s',b'  (et. throw_of e = et  et'. throw_of e' = et')"
proof(induct rule:converse_rtrancl_induct3)
  case refl then show ?case by simp
next
  case (step e0 s0 b0 e1 s1 b1)
  then show ?case by(auto elim: red.cases)
qed

lemma red_hext_incr: "P  e,(h,l,sh),b  e',(h',l',sh'),b'   h  h'"
  and reds_hext_incr: "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'   h  h'"
(*<*)
proof(induct rule:red_reds_inducts)
  case RedNew thus ?case
    by(fastforce dest:new_Addr_SomeD simp:hext_def split:if_splits)
next
  case RedFAss thus ?case by(simp add:hext_def split:if_splits)
qed simp_all
(*>*)


lemma red_lcl_incr: "P  e,(h0,l0,sh0),b  e',(h1,l1,sh1),b'  dom l0  dom l1"
and reds_lcl_incr: "P  es,(h0,l0,sh0),b [→] es',(h1,l1,sh1),b'  dom l0  dom l1"
(*<*)by(induct rule: red_reds_inducts)(auto simp del:fun_upd_apply)(*>*)

lemma red_lcl_add: "P  e,(h,l,sh),b  e',(h',l',sh'),b'  (l0. P  e,(h,l0++l,sh),b  e',(h',l0++l',sh'),b')"
and reds_lcl_add: "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  (l0. P  es,(h,l0++l,sh),b [→] es',(h',l0++l',sh'),b')"
(*<*)
proof (induct rule:red_reds_inducts)
  case RedCast thus ?case by(fastforce intro:red_reds.intros)
next
  case RedCastFail thus ?case by(force intro:red_reds.intros)
next
  case RedFAcc thus ?case by(fastforce intro:red_reds.intros)
next
  case RedCall thus ?case by(fastforce intro:red_reds.intros)
next
  case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T l0)
  have IH: "l0. P  e,(h, l0 ++ l(V  v), sh),b  e',(h', l0 ++ l', sh'),b'"
    and l'V: "l' V = Some v'" by fact+
  from IH have IH': "P  e,(h, (l0 ++ l)(V  v), sh),b  e',(h', l0 ++ l', sh'),b'"
    by simp
  have "(l0 ++ l')(V := (l0 ++ l) V) = l0 ++ l'(V := l V)"
    by(rule ext)(simp add:map_add_def)
  with red_reds.InitBlockRed[OF IH'] l'V show ?case by(simp del:fun_upd_apply)
next
  case (BlockRedNone e h l V sh b e' h' l' sh' b' T l0)
  have IH: "l0. P  e,(h, l0 ++ l(V := None), sh),b  e',(h', l0 ++ l', sh'),b'"
    and l'V: "l' V = None" and unass: "¬ assigned V e" by fact+
  have "l0(V := None) ++ l(V := None) = (l0 ++ l)(V := None)"
    by(simp add:fun_eq_iff map_add_def)
  hence IH': "P  e,(h, (l0++l)(V := None), sh),b  e',(h', l0(V := None) ++ l', sh'),b'"
    using IH[of "l0(V := None)"] by simp
  have "(l0(V := None) ++ l')(V := (l0 ++ l) V) = l0 ++ l'(V := l V)"
    by(simp add:fun_eq_iff map_add_def)
  with red_reds.BlockRedNone[OF IH' _ unass] l'V show ?case
    by(simp add: map_add_def)
next
  case (BlockRedSome e h l V sh b e' h' l' sh' b' v T l0)
  have IH: "l0. P  e,(h, l0 ++ l(V := None), sh),b  e',(h', l0 ++ l', sh'),b'"
    and l'V: "l' V = Some v" and unass: "¬ assigned V e" by fact+
  have "l0(V := None) ++ l(V := None) = (l0 ++ l)(V := None)"
    by(simp add:fun_eq_iff map_add_def)
  hence IH': "P  e,(h, (l0++l)(V := None), sh),b  e',(h', l0(V := None) ++ l', sh'),b'"
    using IH[of "l0(V := None)"] by simp
  have "(l0(V := None) ++ l')(V := (l0 ++ l) V) = l0 ++ l'(V := l V)"
    by(simp add:fun_eq_iff map_add_def)
  with red_reds.BlockRedSome[OF IH' _ unass] l'V show ?case
    by(simp add:map_add_def)
next
  case RedTryCatch thus ?case by(fastforce intro:red_reds.intros)
next
  case RedTryFail thus ?case by(force intro!:red_reds.intros)
qed (simp_all add:red_reds.intros)
(*>*)


lemma Red_lcl_add:
assumes "P  e,(h,l,sh), b →* e',(h',l',sh'), b'" shows "P  e,(h,l0++l,sh),b →* e',(h',l0++l',sh'),b'"
(*<*)
using assms
proof(induct rule:converse_rtrancl_induct_red)
  case 1 thus ?case by simp
next
  case 2 thus ?case
    by (blast dest: red_lcl_add intro: converse_rtrancl_into_rtrancl)
qed
(*>*)

lemma assumes wf: "wwf_J_prog P"
shows red_proc_pres: "P  e,(h,l,sh),b  e',(h',l',sh'),b'
   not_init C e  sh C = (sfs, Processing)  not_init C e'  (sfs'. sh' C = (sfs', Processing))"
  and reds_proc_pres: "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'
   not_inits C es  sh C = (sfs, Processing)  not_inits C es'  (sfs'. sh' C = (sfs', Processing))"
(*<*)
proof(induct rule:red_reds_inducts)
  case RedCall then show ?case
  using sees_wwf_nsub_RI[OF wf RedCall.hyps(2)] sub_RI_blocks_body nsub_RI_not_init by auto
next
  case RedSCall then show ?case
  using sees_wwf_nsub_RI[OF wf RedSCall.hyps(1)] sub_RI_blocks_body nsub_RI_not_init by auto
next
  case (RedInitDone sh C sfs C' Cs e h l b)
  then show ?case by(cases Cs, auto)
next
  case (RedInitProcessing sh C sfs C' Cs e h l b)
  then show ?case by(cases Cs, auto)
next
  case (RedRInit sh C sfs i sh' C' Cs v e h l b)
  then show ?case by(cases Cs, auto)
next
  case (CallThrowParams es vs e es' v M h l sh b)
  then show ?case by(auto dest: not_inits_def')
next
  case (SCallThrowParams es vs e es' C M h l sh b)
  then show ?case by(auto dest: not_inits_def')
qed(auto)

end

Theory EConform

(*  Title:      JinjaDCI/J/EConform.thy
    Author:     Susannah Mansky
    2019-20 UIUC
*)

section ‹ Expression conformance properties ›

theory EConform
imports SmallStep BigStep
begin

lemma cons_to_append: "list  []  (ls. a # list = ls @ [last list])"
 by (metis append_butlast_last_id last_ConsR list.simps(3))

subsection "Initialization conformance"

― ‹ returns class that can be initialized (if any) by top-level expression ›
fun init_class :: "'m prog  'a exp  cname option" where
"init_class P (new C) = Some C" |
"init_class P (CsF{D}) = Some D" |
"init_class P (CsF{D}:=e2) = Some D" |
"init_class P (CsM(es)) = seeing_class P C M" |
"init_class _ _ = None"

lemma icheck_init_class: "icheck P C e  init_class P e = C"
apply(induct e, auto) apply(rename_tac x1 x2 x3 x4)
apply(case_tac x4, auto)
done

― ‹ exp to take next small step (in particular, subexp that may contain initialization) ›
fun ss_exp :: "'a exp  'a exp" and ss_exps :: "'a exp list  'a exp option" where
  "ss_exp (new C) = new C"
| "ss_exp (Cast C e) = (case val_of e of Some v  Cast C e | _  ss_exp e)"
| "ss_exp (Val v) = Val v"
| "ss_exp (e1 «bop» e2) = (case val_of e1 of Some v  (case val_of e2 of Some v  e1 «bop» e2 | _  ss_exp e2)
                                    | _  ss_exp e1)"
| "ss_exp (Var V) = Var V"
| "ss_exp (LAss V e) = (case val_of e of Some v  LAss V e | _  ss_exp e)"
| "ss_exp (eF{D}) = (case val_of e of Some v  eF{D} | _  ss_exp e)"
| "ss_exp (CsF{D}) = CsF{D}"
| "ss_exp (e1F{D}:=e2) = (case val_of e1 of Some v  (case val_of e2 of Some v  e1F{D}:=e2 | _  ss_exp e2)
                                    | _  ss_exp e1)"
| "ss_exp (CsF{D}:=e2) = (case val_of e2 of Some v  CsF{D}:=e2 | _  ss_exp e2)"
| "ss_exp (eM(es)) = (case val_of e of Some v  (case map_vals_of es of Some t  eM(es) | _  the(ss_exps es))
                                    | _  ss_exp e)"
| "ss_exp (CsM(es)) = (case map_vals_of es of Some t  CsM(es) | _  the(ss_exps es))"
| "ss_exp ({V:T; e}) = ss_exp e"
| "ss_exp (e1;;e2) = (case val_of e1 of Some v  ss_exp e2
           | None  (case lass_val_of e1 of Some p  ss_exp e2
                                           | None  ss_exp e1))"
| "ss_exp (if (b) e1 else e2) = (case bool_of b of Some True  if (b) e1 else e2
                                        | Some False  if (b) e1 else e2
                                        | _  ss_exp b)"
| "ss_exp (while (b) e) = while (b) e"
| "ss_exp (throw e) = (case val_of e of Some v  throw e | _  ss_exp e)"
| "ss_exp (try e1 catch(C V) e2) = (case val_of e1 of Some v  try e1 catch(C V) e2
                                            | _  ss_exp e1)"
| "ss_exp (INIT C (Cs,b)  e) = INIT C (Cs,b)  e"
| "ss_exp (RI (C,e);Cs  e') = (case val_of e of Some v  RI (C,e);Cs  e | _  ss_exp e)"
| "ss_exps([]) = None"
| "ss_exps(e#es) = (case val_of e of Some v  ss_exps es | _  Some (ss_exp e))"

(*<*)
lemmas ss_exp_ss_exps_induct = ss_exp_ss_exps.induct
 [ case_names New Cast Val BinOp Var LAss FAcc SFAcc FAss SFAss Call SCall
  Block Seq Cond While Throw Try Init RI Nil Cons ]
(*>*)

lemma icheck_ss_exp:
assumes "icheck P C e" shows "ss_exp e = e"
using assms
proof(cases e)
  case (SFAss C F D e) then show ?thesis using assms
  proof(cases e)qed(auto)
qed(auto)

lemma ss_exps_Vals_None[simp]:
 "ss_exps (map Val vs) = None"
 by(induct vs, auto)

lemma ss_exps_Vals_NoneI:
 "ss_exps es = None  vs. es = map Val vs"
using val_of_spec by(induct es, auto)

lemma ss_exps_throw_nVal:
 " val_of e = None; ss_exps (map Val vs @ throw e # es') = e' 
    e' = ss_exp e"
 by(induct vs, auto)

lemma ss_exps_throw_Val:
 " val_of e = a; ss_exps (map Val vs @ throw e # es') = e' 
    e' = throw e"
 by(induct vs, auto)


abbreviation curr_init :: "'m prog  'a exp  cname option" where
"curr_init P e  init_class P (ss_exp e)"
abbreviation curr_inits :: "'m prog  'a exp list  cname option" where
"curr_inits P es  case ss_exps es of Some e  init_class P e | _  None"

lemma icheck_curr_init': "e'. ss_exp e = e'  icheck P C e'  curr_init P e = C"
 and icheck_curr_inits': "e. ss_exps es = e  icheck P C e  curr_inits P es = C"
proof(induct rule: ss_exp_ss_exps_induct)
qed(simp_all add: icheck_init_class)

lemma icheck_curr_init: "icheck P C e'  ss_exp e = e'  curr_init P e = C"
 by(rule icheck_curr_init')

lemma icheck_curr_inits: "icheck P C e  ss_exps es = e  curr_inits P es = C"
 by(rule icheck_curr_inits')

definition initPD :: "sheap  cname  bool" where
"initPD sh C  sfs i. sh C = Some (sfs, i)  (i = Done  i = Processing)"

― ‹ checks that @{text INIT} and @{text RI} conform and are only in the main computation ›
fun iconf :: "sheap  'a exp  bool" and iconfs :: " sheap  'a exp list  bool" where
  "iconf sh (new C) = True"
| "iconf sh (Cast C e) = iconf sh e"
| "iconf sh (Val v) = True"
| "iconf sh (e1 «bop» e2) = (case val_of e1 of Some v  iconf sh e2 | _  iconf sh e1  ¬sub_RI e2)"
| "iconf sh (Var V) = True"
| "iconf sh (LAss V e) = iconf sh e"
| "iconf sh (eF{D}) = iconf sh e"
| "iconf sh (CsF{D}) = True"
| "iconf sh (e1F{D}:=e2) = (case val_of e1 of Some v  iconf sh e2 | _  iconf sh e1  ¬sub_RI e2)"
| "iconf sh (CsF{D}:=e2) = iconf sh e2"
| "iconf sh (eM(es)) = (case val_of e of Some v  iconfs sh es | _  iconf sh e  ¬sub_RIs es)"
| "iconf sh (CsM(es)) = iconfs sh es"
| "iconf sh ({V:T; e}) = iconf sh e"
| "iconf sh (e1;;e2) = (case val_of e1 of Some v  iconf sh e2
           | None  (case lass_val_of e1 of Some p  iconf sh e2
                                           | None  iconf sh e1  ¬sub_RI e2))"
| "iconf sh (if (b) e1 else e2) = (iconf sh b  ¬sub_RI e1  ¬sub_RI e2)"
| "iconf sh (while (b) e) = (¬sub_RI b  ¬sub_RI e)"
| "iconf sh (throw e) = iconf sh e"
| "iconf sh (try e1 catch(C V) e2) = (iconf sh e1  ¬sub_RI e2)"
| "iconf sh (INIT C (Cs,b)  e) = ((case Cs of Nil  initPD sh C | C'#Cs'  last Cs = C)  ¬sub_RI e)"
| "iconf sh (RI (C,e);Cs  e') = (iconf sh e  ¬sub_RI e')"
| "iconfs sh ([]) = True"
| "iconfs sh (e#es) = (case val_of e of Some v  iconfs sh es | _  iconf sh e  ¬sub_RIs es)"

lemma iconfs_map_throw: "iconfs sh (map Val vs @ throw e # es')  iconf sh e"
 by(induct vs,auto)

lemma nsub_RI_iconf_aux:
 "(¬sub_RI (e::'a exp)  (e'. e'  subexp e  ¬sub_RI e'  iconf sh e')  iconf sh e)
  (¬sub_RIs (es::'a exp list)  (e'. e'  subexps es  ¬sub_RI e'  iconf sh e')  iconfs sh es)"
proof(induct rule: sub_RI_sub_RIs.induct) qed(auto)

lemma nsub_RI_iconf_aux':
 "(e'. subexp_of e' e  ¬sub_RI e'  iconf sh e')  (¬sub_RI e  iconf sh e)"
 by(simp add: nsub_RI_iconf_aux)

lemma nsub_RI_iconf: "¬sub_RI e  iconf sh e"
apply(cut_tac e = e and R = "λe. ¬sub_RI e  iconf sh e" in subexp_induct)
   apply(rename_tac ea) apply(case_tac ea, simp_all)
apply(clarsimp simp: nsub_RI_iconf_aux)
done

lemma nsub_RIs_iconfs: "¬sub_RIs es  iconfs sh es"
apply(cut_tac es = es and R = "λe. ¬sub_RI e  iconf sh e"
  and Rs = "λes. ¬sub_RIs es  iconfs sh es" in subexps_induct)
   apply(rename_tac esa) apply(case_tac esa, simp_all)
 apply(clarsimp simp: nsub_RI_iconf_aux)+
done

lemma lass_val_of_iconf: "lass_val_of e = a  iconf sh e"
 by(drule lass_val_of_nsub_RI, erule nsub_RI_iconf)

lemma icheck_iconf:
assumes "icheck P C e" shows "iconf sh e"
using assms
proof(cases e)
  case (SFAss C F D e) then show ?thesis using assms
  proof(cases e)qed(auto)
next
  case (SCall C M es) then show ?thesis using assms
    by (auto simp: nsub_RIs_iconfs)
next
qed(auto)


subsection "Indicator boolean conformance"

― ‹ checks that the given expression, indicator boolean pair is allowed in small-step
  (i.e., if @{term b} is True, then @{term e} is an initialization-calling expression to
  a class that is marked either @{term Processing} or @{term Done}) ›
definition bconf :: "'m prog  sheap  'a exp  bool  bool"  ("_,_ b '(_,_') " [51,51,0,0] 50)
where
  "P,sh b (e,b)    b  (C. icheck P C (ss_exp e)  initPD sh C)"

definition bconfs :: "'m prog  sheap  'a exp list  bool  bool"  ("_,_ b '(_,_') " [51,51,0,0] 50)
where
  "P,sh b (es,b)    b  (C. (icheck P C (the(ss_exps es))
                            (curr_inits P es = Some C)  initPD sh C))"


― ‹ bconf helper lemmas ›

lemma bconf_nonVal[simp]:
 "P,sh b (e,True)   val_of e = None"
 by(cases e, auto simp: bconf_def)

lemma bconfs_nonVals[simp]:
 "P,sh b (es,True)   map_vals_of es = None"
 by(induct es, auto simp: bconfs_def)

lemma bconf_Cast[iff]:
 "P,sh b (Cast C e,b)   P,sh b (e,b) "
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconf_BinOp[iff]:
 "P,sh b (e1 «bop» e2,b) 
    (case val_of e1 of Some v  P,sh b (e2,b)  | _  P,sh b (e1,b) )"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconf_LAss[iff]:
 "P,sh b (LAss V e,b)   P,sh b (e,b) "
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconf_FAcc[iff]:
 "P,sh b (eF{D},b)   P,sh b (e,b) "
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconf_FAss[iff]:
 "P,sh b (FAss e1 F D e2,b) 
    (case val_of e1 of Some v  P,sh b (e2,b)  | _  P,sh b (e1,b) )"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconf_SFAss[iff]:
"val_of e2 = None  P,sh b (SFAss C F D e2,b)   P,sh b (e2,b) "
 by(unfold bconf_def, cases b, auto)

lemma bconfs_Vals[iff]:
 "P,sh b (map Val vs, b)   ¬ b"
 by(unfold bconfs_def, simp)

lemma bconf_Call[iff]:
 "P,sh b (eM(es),b) 
    (case val_of e of Some v  P,sh b (es,b)  | _  P,sh b (e,b) )"
proof(cases b)
  case True
  then show ?thesis
  proof(cases "ss_exps es")
    case None
    then obtain vs where "es = map Val vs" using ss_exps_Vals_NoneI by auto
    then have mv: "map_vals_of es = vs" by simp
    then show ?thesis by(auto simp: bconf_def) (simp add: bconfs_def)
  next
    case (Some a)
    then show ?thesis by(auto simp: bconf_def, auto simp: bconfs_def icheck_init_class)
  qed
qed(simp add: bconf_def bconfs_def)

lemma bconf_SCall[iff]:
assumes mvn: "map_vals_of es = None"
shows "P,sh b (CsM(es),b)   P,sh b (es,b) "
proof(cases b)
  case True
  then show ?thesis
  proof(cases "ss_exps es")
    case None
      then have "vs. es = map Val vs" using ss_exps_Vals_NoneI by auto
      then show ?thesis using mvn finals_def by clarsimp
    next
    case (Some a)
      then show ?thesis by(auto simp: bconf_def, auto simp: bconfs_def icheck_init_class)
    qed
qed(simp add: bconf_def bconfs_def)

lemma bconf_Cons[iff]:
 "P,sh b (e#es,b) 
    (case val_of e of Some v  P,sh b (es,b)  | _  P,sh b (e,b) )"
proof(cases b)
  case True
  then show ?thesis
  proof(cases "ss_exps es")
    case None
      then have "vs. es = map Val vs" using ss_exps_Vals_NoneI by auto
      then show ?thesis using None by(auto simp: bconf_def bconfs_def icheck_init_class)
    next
    case (Some a)
      then show ?thesis by(auto simp: bconf_def bconfs_def icheck_init_class)
    qed
qed(simp add: bconf_def bconfs_def)

lemma bconf_InitBlock[iff]:
 "P,sh b ({V:T; V:=Val v;; e2},b)   P,sh b (e2,b) "
 by(unfold bconf_def, cases b, auto simp: assigned_def)

lemma bconf_Block[iff]:
 "P,sh b ({V:T; e},b)   P,sh b (e,b) "
 by(unfold bconf_def, cases b, auto)

lemma bconf_Seq[iff]:
 "P,sh b (e1;;e2,b) 
    (case val_of e1 of Some v  P,sh b (e2,b) 
                             | _  (case lass_val_of e1 of Some p  P,sh b (e2,b) 
                                                          | None  P,sh b (e1,b) ))" (* ⟷ P,sh ⊢b (e1,b) √"*)
by(unfold bconf_def, cases b, auto dest: val_of_spec lass_val_of_spec)

lemma bconf_Cond[iff]:
 "P,sh b (if (b) e1 else e2,b')   P,sh b (b,b') "
apply(unfold bconf_def, cases "bool_of b") apply auto[1]
apply(rename_tac a) apply(case_tac a)
 apply(simp, drule bool_of_specT) apply auto[1]
apply(simp, drule bool_of_specF) apply auto[1]
done

lemma bconf_While[iff]:
 "P,sh b (while (b) e,b')   ¬b'"
 by(unfold bconf_def, cases b, auto)

lemma bconf_Throw[iff]:
 "P,sh b (throw e,b)   P,sh b (e,b) "
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconf_Try[iff]:
 "P,sh b (try e1 catch(C V) e2,b)   P,sh b (e1,b) "
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconf_INIT[iff]:
 "P,sh b (INIT C (Cs,b')  e,b)   ¬b"
 by(unfold bconf_def, cases b, auto)

lemma bconf_RI[iff]:
 "P,sh b (RI(C,e);Cs  e',b)   P,sh b (e,b) "
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done

lemma bconfs_map_throw[iff]:
 "P,sh b (map Val vs @ throw e # es',b)   P,sh b (e,b) "
 by(induct vs, auto)

end

Theory Progress

(*  Title:      JinjaDCI/J/Progress.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/Progress.thy by Tobias Nipkow
*)

section ‹ Progress of Small Step Semantics ›

theory Progress
imports WellTypeRT DefAss "../Common/Conform" EConform
begin

lemma final_addrE:
  " P,E,h,sh  e : Class C; final e;
    a. e = addr a  R;
    a. e = Throw a  R   R"
(*<*)by(auto simp:final_def)(*>*)


lemma finalRefE:
 " P,E,h,sh  e : T; is_refT T; final e;
   e = null  R;
   a C.  e = addr a; T = Class C   R;
   a. e = Throw a  R   R"
(*<*)by(auto simp:final_def is_refT_def)(*>*)


text‹ Derivation of new induction scheme for well typing: ›

inductive
  WTrt' :: "[J_prog,heap,sheap,env,expr,ty]  bool"
  and WTrts' :: "[J_prog,heap,sheap,env,expr list, ty list]  bool"
  and WTrt2' :: "[J_prog,env,heap,sheap,expr,ty]  bool"
        ("_,_,_,_  _ :'' _"   [51,51,51,51]50)
  and WTrts2' :: "[J_prog,env,heap,sheap,expr list, ty list]  bool"
        ("_,_,_,_  _ [:''] _" [51,51,51,51]50)
  for P :: J_prog and h :: heap and sh :: sheap
where
  "P,E,h,sh  e :' T  WTrt' P h sh E e T"
| "P,E,h,sh  es [:'] Ts  WTrts' P h sh E es Ts"

| "is_class P C    P,E,h,sh  new C :' Class C"
| " P,E,h,sh  e :' T; is_refT T; is_class P C 
   P,E,h,sh  Cast C e :' Class C"
| "typeofh v = Some T  P,E,h,sh  Val v :' T"
| "E v = Some T    P,E,h,sh  Var v :' T"
| " P,E,h,sh  e1 :' T1;  P,E,h,sh  e2 :' T2 
   P,E,h,sh  e1 «Eq» e2 :' Boolean"
| " P,E,h,sh  e1 :' Integer;  P,E,h,sh  e2 :' Integer 
   P,E,h,sh  e1 «Add» e2 :' Integer"
| " P,E,h,sh  Var V :' T;  P,E,h,sh  e :' T';  P  T'  T 
   P,E,h,sh  V:=e :' Void"
| " P,E,h,sh  e :' Class C; P  C has F,NonStatic:T in D   P,E,h,sh  eF{D} :' T"
| "P,E,h,sh  e :' NT  P,E,h,sh  eF{D} :' T"
| " P  C has F,Static:T in D   P,E,h,sh  CsF{D} :' T"
| " P,E,h,sh  e1 :' Class C;  P  C has F,NonStatic:T in D;
    P,E,h,sh  e2 :' T2;  P  T2  T 
   P,E,h,sh  e1F{D}:=e2 :' Void"
| " P,E,h,sh  e1:'NT; P,E,h,sh  e2 :' T2   P,E,h,sh  e1F{D}:=e2 :' Void"
| " P  C has F,Static:T in D;
    P,E,h,sh  e2 :' T2;  P  T2  T 
   P,E,h,sh  CsF{D}:=e2 :' Void"
| " P,E,h,sh  e :' Class C; P  C sees M,NonStatic:Ts  T = (pns,body) in D;
    P,E,h,sh  es [:'] Ts'; P  Ts' [≤] Ts 
   P,E,h,sh  eM(es) :' T"
| " P,E,h,sh  e :' NT; P,E,h,sh  es [:'] Ts   P,E,h,sh  eM(es) :' T"
| " P  C sees M,Static:Ts  T = (pns,body) in D;
    P,E,h,sh  es [:'] Ts'; P  Ts' [≤] Ts;
    M = clinit  sh D = (sfs,Processing)  es = map Val vs 
   P,E,h,sh  CsM(es) :' T"
| "P,E,h,sh  [] [:'] []"
| " P,E,h,sh  e :' T;  P,E,h,sh  es [:'] Ts    P,E,h,sh  e#es [:'] T#Ts"
| " typeofh v = Some T1; P  T1  T; P,E(VT),h,sh  e2 :' T2 
    P,E,h,sh  {V:T := Val v; e2} :' T2"
| " P,E(VT),h,sh  e :' T'; ¬ assigned V e    P,E,h,sh  {V:T; e} :' T'"
| " P,E,h,sh  e1:' T1;  P,E,h,sh  e2:'T2     P,E,h,sh  e1;;e2 :' T2"
| " P,E,h,sh  e :' Boolean;  P,E,h,sh  e1:' T1;  P,E,h,sh  e2:' T2;
    P  T1  T2  P  T2  T1;
    P  T1  T2  T = T2; P  T2  T1  T = T1 
   P,E,h,sh  if (e) e1 else e2 :' T"
| " P,E,h,sh  e :' Boolean;  P,E,h,sh  c:' T 
    P,E,h,sh  while(e) c :' Void"
| " P,E,h,sh  e :' Tr; is_refT Tr     P,E,h,sh  throw e :' T"
| " P,E,h,sh  e1 :' T1;  P,E(V  Class C),h,sh  e2 :' T2; P  T1  T2 
   P,E,h,sh  try e1 catch(C V) e2 :' T2"
| " P,E,h,sh  e :' T; C'  set (C#Cs). is_class P C'; ¬sub_RI e;
     C'  set (tl Cs). sfs. sh C' = (sfs,Processing);
     b  (C'  set Cs. sfs. sh C' = (sfs,Processing));
     distinct Cs; supercls_lst P Cs   P,E,h,sh  INIT C (Cs, b)  e :' T"
| " P,E,h,sh  e :' T; P,E,h,sh  e' :' T'; C'  set (C#Cs). is_class P C'; ¬sub_RI e';
     C'  set (C#Cs). not_init C' e;
     C'  set Cs. sfs. sh C' = (sfs,Processing);
     sfs. sh C = (sfs, Processing)  (sh C = (sfs, Error)  e = THROW NoClassDefFoundError);
     distinct (C#Cs); supercls_lst P (C#Cs) 
   P,E,h,sh  RI(C, e);Cs  e' :' T'"

(*<*)
lemmas WTrt'_induct = WTrt'_WTrts'.induct [split_format (complete)]
  and WTrt'_inducts = WTrt'_WTrts'.inducts [split_format (complete)]

inductive_cases WTrt'_elim_cases[elim!]:
  "P,E,h,sh  V :=e :' T"
(*>*)

lemma [iff]: "P,E,h,sh  e1;;e2 :' T2 = (T1. P,E,h,sh  e1:' T1  P,E,h,sh  e2:' T2)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
(*>*)

lemma [iff]: "P,E,h,sh  Val v :' T = (typeofh v = Some T)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
(*>*)

lemma [iff]: "P,E,h,sh  Var v :' T = (E v = Some T)"
(*<*)
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
(*>*)


lemma wt_wt': "P,E,h,sh  e : T  P,E,h,sh  e :' T"
and wts_wts': "P,E,h,sh  es [:] Ts  P,E,h,sh  es [:'] Ts"
(*<*)
apply (induct rule:WTrt_inducts)
prefer 17
apply(case_tac "assigned V e")
apply(clarsimp simp add:fun_upd_same assigned_def simp del:fun_upd_apply)
apply(erule (2) WTrt'_WTrts'.intros)
apply(erule (1) WTrt'_WTrts'.intros)
apply(blast intro:WTrt'_WTrts'.intros)+
done
(*>*)


lemma wt'_wt: "P,E,h,sh  e :' T  P,E,h,sh  e : T"
and wts'_wts: "P,E,h,sh  es [:'] Ts  P,E,h,sh  es [:] Ts"
(*<*)
apply (induct rule:WTrt'_inducts)
prefer 19
apply(rule WTrt_WTrts.intros)
apply(rule WTrt_WTrts.intros)
apply(rule WTrt_WTrts.intros)
apply simp
apply(erule (2) WTrt_WTrts.intros)
apply(blast intro:WTrt_WTrts.intros)+
done
(*>*)


corollary wt'_iff_wt: "(P,E,h,sh  e :' T) = (P,E,h,sh  e : T)"
(*<*)by(blast intro:wt_wt' wt'_wt)(*>*)


corollary wts'_iff_wts: "(P,E,h,sh  es [:'] Ts) = (P,E,h,sh  es [:] Ts)"
(*<*)by(blast intro:wts_wts' wts'_wts)(*>*)

(*<*)
lemmas WTrt_inducts2 = WTrt'_inducts [unfolded wt'_iff_wt wts'_iff_wts,
 case_names WTrtNew WTrtCast WTrtVal WTrtVar WTrtBinOpEq WTrtBinOpAdd WTrtLAss
 WTrtFAcc WTrtFAccNT WTrtSFAcc WTrtFAss WTrtFAssNT WTrtSFAss WTrtCall WTrtCallNT WTrtSCall
 WTrtNil WTrtCons WTrtInitBlock WTrtBlock WTrtSeq WTrtCond WTrtWhile WTrtThrow WTrtTry
 WTrtInit WTrtRI, consumes 1]
(*>*)

theorem assumes wf: "wwf_J_prog P" and hconf: "P  h " and shconf: "P,h s sh "
shows progress: "P,E,h,sh  e : T 
 (l.  𝒟 e dom l; P,sh b (e,b) ; ¬ final e   e' s' b'. P  e,(h,l,sh),b  e',s',b')"
and "P,E,h,sh  es [:] Ts 
 (l.  𝒟s es dom l; P,sh b (es,b) ; ¬ finals es   es' s' b'. P  es,(h,l,sh),b [→] es',s',b')"
(*<*)
proof (induct rule:WTrt_inducts2)
  case (WTrtNew C) show ?case
  proof (cases b)
    case True then show ?thesis
    proof cases
      assume "a. h a = None"
      with assms WTrtNew True show ?thesis
        by (fastforce del:exE intro!:RedNew simp add:new_Addr_def
                     elim!:wf_Fields_Ex[THEN exE])
    next
      assume "¬(a. h a = None)"
      with assms WTrtNew True show ?thesis
        by(fastforce intro:RedNewFail simp:new_Addr_def)
    qed
  next
    case False then show ?thesis
    proof cases
      assume "sfs. sh C = Some (sfs, Done)"
      with assms WTrtNew False show ?thesis
        by(fastforce intro:NewInitDoneRed simp:new_Addr_def)
    next
      assume "sfs. sh C = Some (sfs, Done)"
      with assms WTrtNew False show ?thesis
        by(fastforce intro:NewInitRed simp:new_Addr_def)
    qed
  qed
next
  case (WTrtCast E e T C)
  have wte: "P,E,h,sh  e : T" and ref: "is_refT T"
   and IH: "l. 𝒟 e dom l; P,sh b (e,b) ; ¬ final e
                 e' s' b'. P  e,(h,l,sh),b  e',s',b'"
   and D: "𝒟 (Cast C e) dom l"
   and castconf: "P,sh b (Cast C e,b) " by fact+
  from D have De: "𝒟 e dom l" by auto
  have bconf: "P,sh b (e,b) " using castconf bconf_Cast by fast
  show ?case
  proof cases
    assume "final e"
    with wte ref show ?thesis
    proof (rule finalRefE)
      assume "e = null" thus ?case by(fastforce intro:RedCastNull)
    next
      fix D a assume A: "T = Class D" "e = addr a"
      show ?thesis
      proof cases
        assume "P  D * C"
        thus ?thesis using A wte by(fastforce intro:RedCast)
      next
        assume "¬ P  D * C"
        thus ?thesis using A wte by(fastforce elim!:RedCastFail)
      qed
    next
      fix a assume "e = Throw a"
      thus ?thesis by(blast intro!:red_reds.CastThrow)
    qed
  next
    assume nf: "¬ final e"
    from IH[OF De bconf nf] show ?thesis by (blast intro:CastRed)
  qed
next
  case WTrtVal thus ?case by(simp add:final_def)
next
  case WTrtVar thus ?case by(fastforce intro:RedVar simp:hyper_isin_def)
next
  case (WTrtBinOpEq E e1 T1 e2 T2) show ?case
  proof cases
    assume "final e1"
    thus ?thesis
    proof (rule finalE)
      fix v1 assume eV[simp]: "e1 = Val v1"
      show ?thesis
      proof cases
        assume "final e2"
        thus ?thesis
        proof (rule finalE)
          fix v2 assume "e2 = Val v2"
          thus ?thesis using WTrtBinOpEq by(fastforce intro:RedBinOp)
        next
          fix a assume "e2 = Throw a"
          thus ?thesis using eV by(blast intro:red_reds.BinOpThrow2)
        qed
      next
        assume nf: "¬ final e2"
        then have "P,sh b (e2,b) " using WTrtBinOpEq.prems(2) by(simp add:bconf_BinOp)
        with WTrtBinOpEq nf show ?thesis
          by simp (fast intro!:BinOpRed2)
      qed
    next
      fix a assume "e1 = Throw a"
      thus ?thesis by (fast intro:red_reds.BinOpThrow1)
    qed
  next
    assume nf: "¬ final e1"
    then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
    then have "P,sh b (e1,b) " using WTrtBinOpEq.prems(2) by(simp add:bconf_BinOp)
    with WTrtBinOpEq nf e1 show ?thesis
      by simp (fast intro:BinOpRed1)
  qed
next
  case (WTrtBinOpAdd E e1 e2) show ?case
  proof cases
    assume "final e1"
    thus ?thesis
    proof (rule finalE)
      fix v1 assume eV[simp]: "e1 = Val v1"
      show ?thesis
      proof cases
        assume "final e2"
        thus ?thesis
        proof (rule finalE)
          fix v2 assume eV2:"e2 = Val v2"
          then obtain i1 i2 where "v1 = Intg i1  v2 = Intg i2" using WTrtBinOpAdd by clarsimp
          thus ?thesis using WTrtBinOpAdd eV eV2 by(fastforce intro:RedBinOp)
        next
          fix a assume "e2 = Throw a"
          thus ?thesis using eV by(blast intro:red_reds.BinOpThrow2)
        qed
      next
        assume nf:"¬ final e2"
        then have "P,sh b (e2,b) " using WTrtBinOpAdd.prems(2) by(simp add:bconf_BinOp)
        with WTrtBinOpAdd nf show ?thesis
          by simp (fast intro!:BinOpRed2)
      qed
    next
      fix a assume "e1 = Throw a"
      thus ?thesis by(fast intro:red_reds.BinOpThrow1)
    qed
  next
    assume nf: "¬ final e1"
    then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
    then have "P,sh b (e1,b) " using WTrtBinOpAdd.prems(2) by(simp add:bconf_BinOp)
    with WTrtBinOpAdd nf e1 show ?thesis
      by simp (fast intro:BinOpRed1)
  qed
next
  case (WTrtLAss E V T e T')
  then have bconf: "P,sh b (e,b) " using bconf_LAss by fast
  show ?case
  proof cases
    assume "final e" with WTrtLAss show ?thesis
      by(fastforce simp:final_def intro: red_reds.RedLAss red_reds.LAssThrow)
  next
    assume "¬ final e" with WTrtLAss bconf show ?thesis
      by simp (fast intro:LAssRed)
  qed
next
  case (WTrtFAcc E e C F T D)
  then have bconf: "P,sh b (e,b) " using bconf_FAcc by fast
  have wte: "P,E,h,sh  e : Class C"
   and field: "P  C has F,NonStatic:T in D" by fact+
  show ?case
  proof cases
    assume "final e"
    with wte show ?thesis
    proof (rule final_addrE)
      fix a assume e: "e = addr a"
      with wte obtain fs where hp: "h a = Some(C,fs)" by auto
      with hconf have "P,h  (C,fs) " using hconf_def by fastforce
      then obtain v where "fs(F,D) = Some v" using field
        by(fastforce dest:has_fields_fun simp:oconf_def has_field_def)
      with hp e show ?thesis by (meson field red_reds.RedFAcc)
    next
      fix a assume "e = Throw a"
      thus ?thesis by(fastforce intro:red_reds.FAccThrow)
    qed
  next
    assume "¬ final e" with WTrtFAcc bconf show ?thesis
      by(fastforce intro!:FAccRed)
  qed
next
  case (WTrtFAccNT E e F D T)
  then have bconf: "P,sh b (e,b) " using bconf_FAcc by fast
  show ?case
  proof cases
    assume "final e"  ― ‹@{term e} is @{term null} or @{term throw}›
    with WTrtFAccNT show ?thesis
      by(fastforce simp:final_def intro: red_reds.RedFAccNull red_reds.FAccThrow)
  next
    assume "¬ final e" ― ‹@{term e} reduces by IH›
    with WTrtFAccNT bconf show ?thesis by simp (fast intro:FAccRed)
  qed
next
case (WTrtSFAcc C F T D E) then show ?case
  proof (cases b)
    case True
    then obtain sfs i where shD: "sh D = (sfs,i)"
      using bconf_def[of P sh "CsF{D}" b] WTrtSFAcc.prems(2) initPD_def by auto
    with shconf have "P,h,D s sfs " using shconf_def[of P h sh] by auto
    then obtain v where sfsF: "sfs F = Some v" using WTrtSFAcc.hyps
      by(unfold soconf_def) (auto dest:has_field_idemp)
    then show ?thesis using WTrtSFAcc.hyps shD sfsF True
      by(fastforce elim:RedSFAcc)
  next
    case False
    with assms WTrtSFAcc show ?thesis
      by(metis (full_types) SFAccInitDoneRed SFAccInitRed)
  qed
next
  case (WTrtFAss E e1 C F T D e2 T2)
  have wte1: "P,E,h,sh  e1 : Class C" and field: "P  C has F,NonStatic:T in D" by fact+
  show ?case
  proof cases
    assume "final e1"
    with wte1 show ?thesis
    proof (rule final_addrE)
      fix a assume e1: "e1 = addr a"
      show ?thesis
      proof cases
        assume "final e2"
        thus ?thesis
        proof (rule finalE)
          fix v assume "e2 = Val v"
          thus ?thesis using e1 wte1 by(fastforce intro: RedFAss[OF field])
        next
          fix a assume "e2 = Throw a"
          thus ?thesis using e1 by(fastforce intro:red_reds.FAssThrow2)
        qed
      next
        assume nf: "¬ final e2"
        then have "P,sh b (e2,b) " using WTrtFAss.prems(2) e1 by(simp add:bconf_FAss)
        with WTrtFAss e1 nf show ?thesis
          by simp (fast intro!:FAssRed2)
      qed
    next
      fix a assume "e1 = Throw a"
      thus ?thesis by(fastforce intro:red_reds.FAssThrow1)
    qed
  next
    assume nf: "¬ final e1"
    then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
    then have "P,sh b (e1,b) " using WTrtFAss.prems(2) by(simp add:bconf_FAss)
    with WTrtFAss nf e1 show ?thesis
      by simp (blast intro!:FAssRed1)
  qed
next
  case (WTrtFAssNT E e1 e2 T2 F D)
  show ?case
  proof cases
    assume e1: "final e1"  ― ‹@{term e1} is @{term null} or @{term throw}›
    show ?thesis
    proof cases
      assume "final e2"  ― ‹@{term e2} is @{term Val} or @{term throw}›
      with WTrtFAssNT e1 show ?thesis
        by(fastforce simp:final_def
                    intro: red_reds.RedFAssNull red_reds.FAssThrow1 red_reds.FAssThrow2)
    next
      assume nf: "¬ final e2" ― ‹@{term e2} reduces by IH›
      show ?thesis
      proof (rule finalE[OF e1])
        fix v assume ev: "e1 = Val v"
        then have "P,sh b (e2,b) " using WTrtFAssNT.prems(2) nf by(simp add:bconf_FAss)
        with WTrtFAssNT ev nf show ?thesis by auto (meson red_reds.FAssRed2)
      next
        fix a assume et: "e1 = Throw a"
        then have "P,sh b (e1,b) " using WTrtFAssNT.prems(2) nf by(simp add:bconf_FAss)
        with WTrtFAssNT et nf show ?thesis by(fastforce intro: red_reds.FAssThrow1)
      qed
    qed
  next
    assume nf: "¬ final e1" ― ‹@{term e1} reduces by IH›
    then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
    then have "P,sh b (e1,b) " using WTrtFAssNT.prems(2) by(simp add:bconf_FAss)
    with WTrtFAssNT nf e1 show ?thesis
      by simp (blast intro!:FAssRed1)
  qed
next
  case (WTrtSFAss C F T D E e2 T2)
  have field: "P  C has F,Static:T in D" by fact+
  show ?case
  proof cases
    assume "final e2"
    thus ?thesis
    proof (rule finalE)
      fix v assume ev: "e2 = Val v"
      then show ?case
      proof (cases b)
        case True
        then obtain sfs i where shD: "sh D = (sfs,i)"
          using bconf_def[of P _ "CsF{D} := e2"] WTrtSFAss.prems(2) initPD_def ev by auto
        with shconf have "P,h,D s sfs " using shconf_def[of P] by auto
        then obtain v where sfsF: "sfs F = Some v" using field
          by(unfold soconf_def) (auto dest:has_field_idemp)
        then show ?thesis using WTrtSFAss.hyps shD sfsF True ev
          by(fastforce elim:RedSFAss)
      next
        case False
        with assms WTrtSFAss ev show ?thesis
          by(metis (full_types) SFAssInitDoneRed SFAssInitRed)
      qed
    next
      fix a assume "e2 = Throw a"
      thus ?thesis by(fastforce intro:red_reds.SFAssThrow)
    qed
  next
    assume nf: "¬ final e2"
    then have "val_of e2 = None" using final_def val_of_spec by fastforce
    then have "P,sh b (e2,b) " using WTrtSFAss.prems(2) by(simp add:bconf_SFAss)
    with WTrtSFAss nf show ?thesis
      by simp (fast intro!:SFAssRed)
  qed
next
  case (WTrtCall E e C M Ts T pns body D es Ts')
  have wte: "P,E,h,sh  e : Class C"
   and "method": "P  C sees M,NonStatic:TsT = (pns,body) in D"
   and wtes: "P,E,h,sh  es [:] Ts'"and sub: "P  Ts' [≤] Ts"
   and IHes: "l.
             𝒟s es dom l; P,sh b (es,b) ; ¬ finals es
              es' s' b'. P  es,(h,l,sh),b [→] es',s',b'"
   and D: "𝒟 (eM(es)) dom l" by fact+
  show ?case
  proof cases
    assume "final e"
    with wte show ?thesis
    proof (rule final_addrE)
      fix a assume e_addr: "e = addr a"
      show ?thesis
      proof cases
        assume es: "vs. es = map Val vs"
        from wte e_addr obtain fs where ha: "h a = Some(C,fs)" by auto
        show ?thesis
          using e_addr ha "method" WTrts_same_length[OF wtes] sub es sees_wf_mdecl[OF wf "method"]
          by(fastforce intro!: RedCall simp:list_all2_iff wf_mdecl_def)
      next
        assume "¬(vs. es = map Val vs)"
        hence not_all_Val: "¬(e  set es. v. e = Val v)"
          by(simp add:ex_map_conv)
        let ?ves = "takeWhile (λe. v. e = Val v) es"
        let ?rest = "dropWhile (λe. v. e = Val v) es"
        let ?ex = "hd ?rest" let ?rst = "tl ?rest"
        from not_all_Val have nonempty: "?rest  []" by auto
        hence es: "es = ?ves @ ?ex # ?rst" by simp
        have "e  set ?ves. v. e = Val v" by(fastforce dest:set_takeWhileD)
        then obtain vs where ves: "?ves = map Val vs"
          using ex_map_conv by blast
        show ?thesis
        proof cases
          assume "final ?ex"
          moreover from nonempty have "¬(v. ?ex = Val v)"
            by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
              (simp add:dropWhile_eq_Cons_conv)
          ultimately obtain b where ex_Throw: "?ex = Throw b"
            by(fast elim!:finalE)
          show ?thesis using e_addr es ex_Throw ves
            by(fastforce intro:CallThrowParams)
        next
          assume not_fin: "¬ final ?ex"
          have "finals es = finals(?ves @ ?ex # ?rst)" using es
            by(rule arg_cong)
          also have " = finals(?ex # ?rst)" using ves by simp
          finally have "finals es = finals(?ex # ?rst)" .
          hence fes: "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
          have "P,sh b (es,b) " using bconf_Call WTrtCall.prems(2)
            by (metis e_addr option.simps(5) val_of.simps(1))
          thus ?thesis using fes e_addr D IHes by(fastforce intro!:CallParams)
        qed
      qed
    next
      fix a assume "e = Throw a"
      with WTrtCall.prems show ?thesis by(fast intro!:CallThrowObj)
    qed
  next
    assume nf: "¬ final e"
    then have e1: "val_of e = None" proof(cases e)qed(auto)
    then have "P,sh b (e,b) " using WTrtCall.prems(2) by(simp add:bconf_Call)
    with WTrtCall nf e1 show ?thesis by simp (blast intro!:CallObj)
  qed
next
  case (WTrtCallNT E e es Ts M T) show ?case
  proof cases
    assume "final e"
    moreover
    { fix v assume e: "e = Val v"
      hence "e = null" using WTrtCallNT by simp
      have ?case
      proof cases
        assume "finals es"
        moreover
        { fix vs assume "es = map Val vs"
          with WTrtCallNT e have ?thesis by(fastforce intro: RedCallNull) }
        moreover
        { fix vs a es' assume "es = map Val vs @ Throw a # es'"
          with WTrtCallNT e have ?thesis by(fastforce intro: CallThrowParams) }
        ultimately show ?thesis by(fastforce simp:finals_def)
      next
        assume nf: "¬ finals es" ― ‹@{term es} reduces by IH›
        have "P,sh b (es,b) " using WTrtCallNT.prems(2) e by (simp add: bconf_Call)
        with WTrtCallNT e nf show ?thesis by(fastforce intro: CallParams)
      qed
    }
    moreover
    { fix a assume "e = Throw a"
      with WTrtCallNT have ?case by(fastforce intro: CallThrowObj) }
    ultimately show ?thesis by(fastforce simp:final_def)
  next
    assume nf: "¬ final e" ― ‹@{term e} reduces by IH›
    then have "val_of e = None" proof(cases e)qed(auto)
    then have "P,sh b (e,b) " using WTrtCallNT.prems(2) by(simp add:bconf_Call)
    with WTrtCallNT nf show ?thesis by (fastforce intro:CallObj)
  qed
next
  case (WTrtSCall C M Ts T pns body D E es Ts' sfs vs)
  have "method": "P  C sees M,Static:TsT = (pns,body) in D"
   and wtes: "P,E,h,sh  es [:] Ts'"and sub: "P  Ts' [≤] Ts"
   and IHes: "l.
             𝒟s es dom l; P,sh b (es,b) ; ¬ finals es
              es' s' b'. P  es,(h,l,sh),b [→] es',s',b'"
   and clinit: "M = clinit  sh D = (sfs, Processing)  es = map Val vs"
   and D: "𝒟 (CsM(es)) dom l" by fact+
  show ?case
  proof cases
    assume es: "vs. es = map Val vs"
    show ?thesis
    proof (cases b)
      case True
      then show ?thesis
      using "method" WTrts_same_length[OF wtes] sub es sees_wf_mdecl[OF wf "method"] True
      by(fastforce intro!: RedSCall simp:list_all2_iff wf_mdecl_def)
    next
      case False
      show ?thesis
      using "method" clinit WTrts_same_length[OF wtes] sub es False
        by (metis (full_types) red_reds.SCallInitDoneRed red_reds.SCallInitRed)
    qed
  next
    assume nmap: "¬(vs. es = map Val vs)"
    hence not_all_Val: "¬(e  set es. v. e = Val v)"
      by(simp add:ex_map_conv)
    let ?ves = "takeWhile (λe. v. e = Val v) es"
    let ?rest = "dropWhile (λe. v. e = Val v) es"
    let ?ex = "hd ?rest" let ?rst = "tl ?rest"
    from not_all_Val have nonempty: "?rest  []" by auto
    hence es: "es = ?ves @ ?ex # ?rst" by simp
    have "e  set ?ves. v. e = Val v" by(fastforce dest:set_takeWhileD)
    then obtain vs where ves: "?ves = map Val vs"
      using ex_map_conv by blast
    show ?thesis
    proof cases
      assume "final ?ex"
      moreover from nonempty have "¬(v. ?ex = Val v)"
        by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
          (simp add:dropWhile_eq_Cons_conv)
      ultimately obtain b where ex_Throw: "?ex = Throw b"
        by(fast elim!:finalE)
      show ?thesis using es ex_Throw ves
        by(fastforce intro:SCallThrowParams)
    next
      assume not_fin: "¬ final ?ex"
      have "finals es = finals(?ves @ ?ex # ?rst)" using es
        by(rule arg_cong)
      also have " = finals(?ex # ?rst)" using ves by simp
      finally have "finals es = finals(?ex # ?rst)" .
      hence fes: "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
      have "P,sh b (es,b) "
        by (meson WTrtSCall.prems(2) nmap bconf_SCall map_vals_of_spec not_None_eq)
      thus ?thesis using fes D IHes by(fastforce intro!:SCallParams)
    qed
  qed
next
  case WTrtNil thus ?case by simp
next
  case (WTrtCons E e T es Ts)
  have IHe: "l. 𝒟 e dom l; P,sh b (e,b) ; ¬ final e
                 e' s' b'. P  e,(h,l,sh),b  e',s',b'"
   and IHes: "l. 𝒟s es dom l; P,sh b (es,b) ; ¬ finals es
              es' s' b'. P  es,(h,l,sh),b [→] es',s',b'"
   and D: "𝒟s (e#es) dom l" and not_fins: "¬ finals(e # es)" by fact+
  have De: "𝒟 e dom l" and Des: "𝒟s es (dom l  𝒜 e)"
    using D by auto
  show ?case
  proof cases
    assume "final e"
    thus ?thesis
    proof (rule finalE)
      fix v assume e: "e = Val v"
      hence Des': "𝒟s es dom l" using De Des by auto
      have bconfs: "P,sh b (es,b) " using WTrtCons.prems(2) e by(simp add: bconf_Cons)
      have not_fins_tl: "¬ finals es" using not_fins e by simp
      show ?thesis using e IHes[OF Des' bconfs not_fins_tl]
        by (blast intro!:ListRed2)
    next
      fix a assume "e = Throw a"
      hence False using not_fins by simp
      thus ?thesis ..
    qed
  next
    assume nf:"¬ final e"
    then have "val_of e = None" proof(cases e)qed(auto)
    then have bconf: "P,sh b (e,b) " using WTrtCons.prems(2) by(simp add: bconf_Cons)
    with IHe[OF De bconf nf] show ?thesis by(fast intro!:ListRed1)
  qed
next
  case (WTrtInitBlock v T1 T E V e2 T2)
  have IH2: "l. 𝒟 e2 dom l; P,sh b (e2,b) ; ¬ final e2
                   e' s' b'. P  e2,(h,l,sh),b  e',s',b'"
   and D: "𝒟 {V:T := Val v; e2} dom l" by fact+
  show ?case
  proof cases
    assume "final e2"
    then show ?thesis
    proof (rule finalE)
      fix v2 assume "e2 = Val v2"
      thus ?thesis by(fast intro:RedInitBlock)
    next
      fix a assume "e2 = Throw a"
      thus ?thesis by(fast intro:red_reds.InitBlockThrow)
    qed
  next
    assume not_fin2: "¬ final e2"
    then have "val_of e2 = None" proof(cases e2)qed(auto)
    from D have D2: "𝒟 e2 dom(l(Vv))" by (auto simp:hyperset_defs)
    have e2conf: "P,sh b (e2,b) " using WTrtInitBlock.prems(2) by(simp add: bconf_InitBlock)
    from IH2[OF D2 e2conf not_fin2]
    obtain h' l' sh' e' b' where red2: "P  e2,(h, l(Vv),sh),b  e',(h', l',sh'),b'"
      by auto
    from red_lcl_incr[OF red2] have "V  dom l'" by auto
    with red2 show ?thesis by(fastforce intro:InitBlockRed)
  qed
next
  case (WTrtBlock E V T e T')
  have IH: "l. 𝒟 e dom l; P,sh b (e,b) ; ¬ final e
                  e' s' b'. P  e,(h,l,sh),b  e',s',b'"
   and unass: "¬ assigned V e" and D: "𝒟 {V:T; e} dom l" by fact+
  show ?case
  proof cases
    assume "final e"
    thus ?thesis
    proof (rule finalE)
      fix v assume "e = Val v" thus ?thesis by(fast intro:RedBlock)
    next
      fix a assume "e = Throw a"
      thus ?thesis by(fast intro:red_reds.BlockThrow)
    qed
  next
    assume not_fin: "¬ final e"
    then have "val_of e = None" proof(cases e)qed(auto)
    from D have De: "𝒟 e dom(l(V:=None))" by(simp add:hyperset_defs)
    have bconf: "P,sh b (e,b) " using WTrtBlock by(simp add: bconf_Block)
    from IH[OF De bconf not_fin]
    obtain h' l' sh' e' b' where red: "P  e,(h,l(V:=None),sh),b  e',(h',l',sh'),b'"
      by auto
    show ?thesis
    proof (cases "l' V")
      assume "l' V = None"
      with red unass show ?thesis by(blast intro: BlockRedNone)
    next
      fix v assume "l' V = Some v"
      with red unass show ?thesis by(blast intro: BlockRedSome)
    qed
  qed
next
  case (WTrtSeq E e1 T1 e2 T2) show ?case
  proof cases
    assume "final e1"
    thus ?thesis
      by(fast elim:finalE intro:RedSeq red_reds.SeqThrow)
  next
    assume nf: "¬ final e1"
    then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
    then show ?thesis
    proof(cases "lass_val_of e1")
      case None
      then have "P,sh b (e1,b) " using WTrtSeq.prems(2) e1 by(simp add: bconf_Seq)
      with WTrtSeq nf e1 None show ?thesis by simp (blast intro:SeqRed)
    next
      case (Some p)
      obtain V v where "e1 = V:=Val v" using lass_val_of_spec[OF Some] by simp
      then show ?thesis using SeqRed[OF RedLAss] by blast
    qed
  qed
next
  case (WTrtCond E e e1 T1 e2 T2 T)
  have wt: "P,E,h,sh  e : Boolean" by fact
  show ?case
  proof cases
    assume "final e"
    thus ?thesis
    proof (rule finalE)
      fix v assume val: "e = Val v"
      then obtain b where v: "v = Bool b" using wt by auto
      show ?thesis
      proof (cases b)
        case True with val v show ?thesis by(fastforce intro:RedCondT simp: prod_cases3)
      next
        case False with val v show ?thesis by(fastforce intro:RedCondF simp: prod_cases3)
      qed
    next
      fix a assume "e = Throw a"
      thus ?thesis by(fast intro:red_reds.CondThrow)
    qed
  next
    assume nf: "¬ final e"
    then have "bool_of e = None" proof(cases e)qed(auto)
    then have "P,sh b (e,b) " using WTrtCond.prems(2) by(simp add: bconf_Cond)
    with WTrtCond nf show ?thesis by simp (blast intro:CondRed)
  qed
next
  case WTrtWhile show ?case by(fast intro:RedWhile)
next
  case (WTrtThrow E e Tr T) show ?case
  proof cases
    assume "final e" ― ‹Then @{term e} must be @{term throw} or @{term null}›
    with WTrtThrow show ?thesis
      by(fastforce simp:final_def is_refT_def
                  intro:red_reds.ThrowThrow red_reds.RedThrowNull)
  next
    assume nf: "¬ final e" ― ‹Then @{term e} must reduce›
    then have "val_of e = None" proof(cases e)qed(auto)
    then have "P,sh b (e,b) " using WTrtThrow.prems(2) by(simp add: bconf_Throw)
    with WTrtThrow nf show ?thesis by simp (blast intro:ThrowRed)
  qed
next
  case (WTrtTry E e1 T1 V C e2 T2)
  have wt1: "P,E,h,sh  e1 : T1" by fact
  show ?case
  proof cases
    assume "final e1"
    thus ?thesis
    proof (rule finalE)
      fix v assume "e1 = Val v"
      thus ?thesis by(fast intro:RedTry)
    next
      fix a assume e1_Throw: "e1 = Throw a"
      with wt1 obtain D fs where ha: "h a = Some(D,fs)" by fastforce
      show ?thesis
      proof cases
        assume "P  D * C"
        with e1_Throw ha show ?thesis by(fastforce intro!:RedTryCatch)
      next
        assume "¬ P  D * C"
        with e1_Throw ha show ?thesis by(fastforce intro!:RedTryFail)
      qed
    qed
  next
    assume nf: "¬ final e1"
    then have "val_of e1 = None" proof(cases e1)qed(auto)
    then have "P,sh b (e1,b) " using WTrtTry.prems(2) by(simp add: bconf_Try)
    with WTrtTry nf show ?thesis by simp (fast intro:TryRed)
  qed
next
  case (WTrtInit E e Tr C Cs b) show ?case
  proof(cases Cs)
    case Nil then show ?thesis using WTrtInit by(fastforce intro!: RedInit)
  next
    case (Cons C' Cs')
    show ?thesis
    proof(cases b)
      case True then show ?thesis using Cons by(fastforce intro!: RedInitRInit)
    next
      case False
      show ?thesis
      proof(cases "sh C'")
        case None
        then show ?thesis using False Cons by(fastforce intro!: InitNoneRed)
      next
        case (Some sfsi)
        then obtain sfs i where sfsi:"sfsi = (sfs,i)" by(cases sfsi)
        show ?thesis
        proof(cases i)
          case Done
          then show ?thesis using False Some sfsi Cons by(fastforce intro!: RedInitDone)
        next
          case Processing
          then show ?thesis using False Some sfsi Cons by(fastforce intro!: RedInitProcessing)
        next
          case Error
          then show ?thesis using False Some sfsi Cons by(fastforce intro!: RedInitError)
        next
          case Prepared
          show ?thesis
          proof cases
            assume "C' = Object"
            then show ?thesis using False Some sfsi Prepared Cons by(fastforce intro: InitObjectRed)
          next
            assume "C'  Object"
            then show ?thesis using False Some sfsi Prepared WTrtInit.hyps(3) Cons
              by(simp only: is_class_def)(fastforce intro!: InitNonObjectSuperRed)
          qed
        qed
      qed
    qed
  qed
next
  case (WTrtRI E e Tr e' Tr' C Cs)
  obtain sfs i where shC: "sh C = (sfs, i)" using WTrtRI.hyps(9) by blast
  show ?case
  proof cases
    assume fin: "final e" then show ?thesis
    proof (rule finalE)
      fix v assume e: "e = Val v"
      then show ?thesis using shC e by(fast intro:RedRInit)
    next
      fix a assume eThrow: "e = Throw a"
      show ?thesis
      proof(cases Cs)
        case Nil then show ?thesis using eThrow shC by(fastforce intro!: RInitThrow)
      next
        case Cons then show ?thesis using eThrow shC by(fastforce intro!: RInitInitThrow)
      qed
    qed
  next
    assume nf: "¬ final e"
    then have "val_of e = None" proof(cases e)qed(auto)
    then have "P,sh b (e,b) " using WTrtRI.prems(2) by(simp add: bconf_RI)
    with WTrtRI nf show ?thesis by simp (meson red_reds.RInitRed)
  qed
qed
(*>*)

end

Theory JWellForm

(*  Title:      JinjaDCI/J/JWellForm.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/JWellForm.thy by Tobias Nipkow
*)

section ‹ Well-formedness Constraints ›

theory JWellForm
imports "../Common/WellForm" WWellForm WellType DefAss
begin

definition wf_J_mdecl :: "J_prog  cname  J_mb mdecl  bool"
where
  "wf_J_mdecl P C    λ(M,b,Ts,T,(pns,body)).
  length Ts = length pns 
  distinct pns 
  ¬sub_RI body 
 (case b of
    NonStatic  this  set pns 
        (T'. P,[thisClass C,pns[↦]Ts]  body :: T'  P  T'  T) 
        𝒟 body {this}  set pns
  | Static  (T'. P,[pns[↦]Ts]  body :: T'  P  T'  T) 
        𝒟 body set pns)"

lemma wf_J_mdecl_NonStatic[simp]:
  "wf_J_mdecl P C (M,NonStatic,Ts,T,pns,body) 
  (length Ts = length pns 
  distinct pns 
  ¬sub_RI body 
  this  set pns 
  (T'. P,[thisClass C,pns[↦]Ts]  body :: T'  P  T'  T) 
  𝒟 body {this}  set pns)"
(*<*)by(simp add:wf_J_mdecl_def)(*>*)

lemma wf_J_mdecl_Static[simp]:
  "wf_J_mdecl P C (M,Static,Ts,T,pns,body) 
  (length Ts = length pns 
  distinct pns 
  ¬sub_RI body 
  (T'. P,[pns[↦]Ts]  body :: T'  P  T'  T) 
  𝒟 body set pns)"
(*<*)by(simp add:wf_J_mdecl_def)(*>*)


abbreviation
  wf_J_prog :: "J_prog  bool" where
  "wf_J_prog == wf_prog wf_J_mdecl"

lemma wf_J_prog_wf_J_mdecl:
  " wf_J_prog P; (C, D, fds, mths)  set P; jmdcl  set mths 
   wf_J_mdecl P C jmdcl"
(*<*)
apply (simp add: wf_prog_def)
apply (simp add: wf_cdecl_def)
apply (erule conjE)+
apply (drule bspec, assumption)
apply simp
apply (erule conjE)+
apply (drule bspec, assumption)
apply (simp add: wf_mdecl_def split_beta)
done
(*>*)
                                  
lemma wf_mdecl_wwf_mdecl: "wf_J_mdecl P C Md  wwf_J_mdecl P C Md"
(*<*)
apply(clarsimp simp:wwf_J_mdecl_def) apply(rename_tac M b Ts T pns body)
apply (case_tac b)
 by (fastforce dest!:WT_fv)+
(*>*)

lemma wf_prog_wwf_prog: "wf_J_prog P  wwf_J_prog P"
(*<*)
apply(simp add:wf_prog_def wf_cdecl_def wf_mdecl_def)
apply(fast intro:wf_mdecl_wwf_mdecl)
done
(*>*)


end

Theory TypeSafe

(*  Title:      JinjaDCI/J/TypeSafe.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/TypeSafe.thy by Tobias Nipkow
*)

section ‹ Type Safety Proof ›

theory TypeSafe
imports Progress BigStep SmallStep JWellForm
begin

(* here because it requires well-typing def *)
lemma red_shext_incr: "P  e,(h,l,sh),b  e',(h',l',sh'),b'
   (E T. P,E,h,sh  e : T  sh s sh')"
  and reds_shext_incr: "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'
   (E Ts. P,E,h,sh  es [:] Ts  sh s sh')"
(*<*)
proof(induct rule:red_reds_inducts) qed(auto simp: shext_def)
(*>*)

lemma wf_types_clinit:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a" and proc: "sh C = (sfs, Processing)"
shows "P,E,h,sh  Csclinit([]) : Void"
proof -
  from ex obtain D fs ms where "a = (D,fs,ms)" by(cases a)
  then have sP: "(C, D, fs, ms)  set P" using ex map_of_SomeD[of P C a] by(simp add: class_def)
  then have "wf_clinit ms" using assms by(unfold wf_prog_def wf_cdecl_def, auto)
  then obtain pns body where sm: "(clinit, Static, [], Void, pns, body)  set ms"
    by(unfold wf_clinit_def) auto
  then have "P  C sees clinit,Static:[]  Void = (pns,body) in C"
    using mdecl_visible[OF wf sP sm] by simp
  then show ?thesis using WTrtSCall proc by simp
qed

subsection‹Basic preservation lemmas›

text‹ First some easy preservation lemmas. ›

theorem red_preserves_hconf:
  "P  e,(h,l,sh),b  e',(h',l',sh'),b'  (T E.  P,E,h,sh  e : T; P  h    P  h' )"
and reds_preserves_hconf:
  "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  (Ts E.  P,E,h,sh  es [:] Ts; P  h    P  h' )"
(*<*)
proof (induct rule:red_reds_inducts)
  case (RedNew h a C FDTs h' l sh es)
  have new: "new_Addr h = Some a" and fields: "P  C has_fields FDTs"
   and h': "h' = h(ablank P C)"
   and hconf: "P  h " by fact+
  from new have None: "h a = None" by(rule new_Addr_SomeD)
  moreover have "P,h  blank P C "
    using fields by(rule oconf_blank)
  ultimately show "P  h' " using h' by(fast intro: hconf_new[OF hconf])
next
  case (RedFAss C F t D h a fs v l sh b')
  let ?fs' = "fs((F,D)v)"
  have hconf: "P  h " and ha: "h a = Some(C,fs)"
   and wt: "P,E,h,sh  addr aF{D}:=Val v : T" by fact+
  from wt ha obtain TF Tv where typeofv: "typeofh v = Some Tv"
    and has: "P  C has F,NonStatic:TF in D"
    and sub: "P  Tv  TF" by auto
  have "P,h  (C, ?fs') "
  proof (rule oconf_fupd[OF has])
    show "P,h  (C, fs) " using hconf ha by(simp add:hconf_def)
    show "P,h  v :≤ TF" using sub typeofv by(simp add:conf_def)
  qed
  with hconf ha show "P  h(a(C, ?fs')) "  by (rule hconf_upd_obj)
qed(auto elim: WTrt.cases)
(*>*)


theorem red_preserves_lconf:
  "P  e,(h,l,sh),b  e',(h',l',sh'),b' 
  (T E.  P,E,h,sh  e:T; P,h  l (:≤) E   P,h'  l' (:≤) E)"
and reds_preserves_lconf:
  "P  es,(h,l,sh),b [→] es',(h',l',sh'),b' 
  (Ts E.  P,E,h,sh  es[:]Ts; P,h  l (:≤) E   P,h'  l' (:≤) E)"
(*<*)
proof(induct rule:red_reds_inducts)
  case RedNew thus ?case
    by(fast intro:lconf_hext red_hext_incr[OF red_reds.RedNew])
next
  case RedLAss thus ?case by(fastforce elim: lconf_upd simp:conf_def)
next
  case RedFAss thus ?case
    by(fast intro:lconf_hext red_hext_incr[OF red_reds.RedFAss])
next
  case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T T')
  have red: "P  e, (h, l(Vv),sh),b  e',(h', l',sh'),b'"
   and IH: "T E .  P,E,h,sh  e:T; P,h  l(Vv) (:≤) E 
                      P,h'  l' (:≤) E"
   and l'V: "l' V = Some v'" and lconf: "P,h  l (:≤) E"
   and wt: "P,E,h,sh  {V:T := Val v; e} : T'" by fact+
  from lconf_hext[OF lconf red_hext_incr[OF red]]
  have "P,h'  l (:≤) E" .
  moreover from IH lconf wt have "P,h'  l' (:≤) E(VT)"
    by(auto simp del: fun_upd_apply simp: fun_upd_same lconf_upd2 conf_def)
  ultimately show "P,h'  l'(V := l V) (:≤) E"
    by (fastforce simp:lconf_def split:if_split_asm)
next
  case (BlockRedNone e h l V sh b e' h' l' sh' b' T T')
  have red: "P  e,(h, l(V := None),sh),b  e',(h', l',sh'),b'"
   and IH: "E T.  P,E,h,sh  e : T; P,h  l(V:=None) (:≤) E 
                    P,h'  l' (:≤) E"
   and lconf: "P,h  l (:≤) E" and wt: "P,E,h,sh  {V:T; e} : T'" by fact+
  from lconf_hext[OF lconf red_hext_incr[OF red]]
  have "P,h'  l (:≤) E" .
  moreover have "P,h'  l' (:≤) E(VT)"
    by(rule IH, insert lconf wt, auto simp:lconf_def)
  ultimately show "P,h'  l'(V := l V) (:≤) E"
    by (fastforce simp:lconf_def split:if_split_asm)
next
  case (BlockRedSome e h l V sh b e' h' l' sh' b' v T T')
  have red: "P  e,(h, l(V := None),sh),b  e',(h', l',sh'),b'"
   and IH: "E T. P,E,h,sh  e : T; P,h  l(V:=None) (:≤) E
                    P,h'  l' (:≤) E"
   and lconf: "P,h  l (:≤) E" and wt: "P,E,h,sh  {V:T; e} : T'" by fact+
  from lconf_hext[OF lconf red_hext_incr[OF red]]
  have "P,h'  l (:≤) E" .
  moreover have "P,h'  l' (:≤) E(VT)"
    by(rule IH, insert lconf wt, auto simp:lconf_def)
  ultimately show "P,h'  l'(V := l V) (:≤) E"
    by (fastforce simp:lconf_def split:if_split_asm)
qed(auto elim: WTrt.cases)
(*>*)


theorem red_preserves_shconf:
  "P  e,(h,l,sh),b  e',(h',l',sh'),b'  (T E.  P,E,h,sh  e : T; P,h s sh    P,h' s sh' )"
and reds_preserves_shconf:
  "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  (Ts E.  P,E,h,sh  es [:] Ts; P,h s sh    P,h' s sh' )"
(*<*)
proof (induct rule:red_reds_inducts)
  case (RedNew h a C FDTs h' l sh es)
  have new: "new_Addr h = Some a"
   and h': "h' = h(ablank P C)"
   and shconf: "P,h s sh " by fact+
  from new have None: "h a = None" by(rule new_Addr_SomeD)
  then show "P,h' s sh " using h' by(fast intro: shconf_hnew[OF shconf])
next
  case (RedFAss C F t D h a fs v l sh b)
  let ?fs' = "fs((F,D)v)"
  have shconf: "P,h s sh " and ha: "h a = Some(C,fs)" by fact+
  then show "P,h(a(C, ?fs')) s sh " by (rule shconf_hupd_obj)
next
  case (RedSFAss C F t D sh sfs i sfs' v sh' h l)
  let ?sfs' = "sfs(Fv)"
  have shconf: "P,h s sh " and shD: "sh D = (sfs, i)"
    and wt: "P,E,h,sh  CsF{D} := Val v : T" by fact+
  from wt obtain TF Tv where typeofv: "typeofh v = Some Tv"
    and has: "P  C has F,Static:TF in D"
    and sub: "P  Tv  TF" by (auto elim: WTrt.cases)
  have has': "P  D has F,Static:TF in D" using has by(rule has_field_idemp)
  have "P,h,D s ?sfs' "
  proof (rule soconf_fupd[OF has'])
    show "P,h,D s sfs " using shconf shD by(simp add:shconf_def)
    show "P,h  v :≤ TF" using sub typeofv by(simp add:conf_def)
  qed
  with shconf have "P,h s sh(D(?sfs',i)) " by (rule shconf_upd_obj)
  then show ?case using RedSFAss.hyps(3) RedSFAss.hyps(4) by blast
next
  case (InitNoneRed sh C C' Cs e h l)
  let ?sfs' = "sblank P C"
  have "P,h s sh(C  (?sfs', Prepared)) "
  proof(rule shconf_upd_obj)
    show "P,h s sh " using InitNoneRed by simp
    show "P,h,C s sblank P C " by (metis has_field_def soconf_def soconf_sblank)
  qed
  then show ?case by blast
next
  case (InitObjectRed sh C sfs sh' C' Cs e h l)
  have sh': "sh' = sh(C  (sfs, Processing))" by fact
  have "P,h s sh(C  (sfs, Processing)) "
  proof(rule shconf_upd_obj)
    show "P,h s sh " using InitObjectRed by simp
    moreover have "sh C = (sfs, Prepared)" using InitObjectRed by simp
    ultimately show "P,h,C s sfs " using shconfD by blast
  qed
  then show ?case using sh' by blast
next
  case (InitNonObjectSuperRed sh C sfs D a b sh' C' Cs e h l)
  have sh': "sh' = sh(C  (sfs, Processing))" by fact
  have "P,h s sh(C  (sfs, Processing)) "
  proof(rule shconf_upd_obj)
    show "P,h s sh " using InitNonObjectSuperRed by simp
    moreover have "sh C = (sfs, Prepared)" using InitNonObjectSuperRed by simp
    ultimately show "P,h,C s sfs " using shconfD by blast
  qed
  then show ?case using sh' by blast
next
  case (RedRInit sh C sfs i sh' C' Cs e v h l)
  have sh': "sh' = sh(C  (sfs, Done))" by fact
  have "P,h s sh(C  (sfs, Done)) "
  proof(rule shconf_upd_obj)
    show "P,h s sh " using RedRInit by simp
    moreover have "sh C = (sfs, i)" using RedRInit by simp
    ultimately show "P,h,C s sfs " using shconfD by blast
  qed
  then show ?case using sh' by blast
next
  case (RInitInitThrow sh C sfs i sh' a D Cs e h l)
  have sh': "sh' = sh(C  (sfs, Error))" by fact
  have "P,h s sh(C  (sfs, Error)) "
  proof(rule shconf_upd_obj)
    show "P,h s sh " using RInitInitThrow by simp
    moreover have "sh C = (sfs, i)" using RInitInitThrow by simp
    ultimately show "P,h,C s sfs " using shconfD by blast
  qed
  then show ?case using sh' by blast
next
  case (RInitThrow sh C sfs i sh' a e' h l)
  have sh': "sh' = sh(C  (sfs, Error))" by fact
  have "P,h s sh(C  (sfs, Error)) "
  proof(rule shconf_upd_obj)
    show "P,h s sh " using RInitThrow by simp
    moreover have "sh C = (sfs, i)" using RInitThrow by simp
    ultimately show "P,h,C s sfs " using shconfD by blast
  qed
  then show ?case using sh' by blast
qed(auto elim: WTrt.cases)
(*>*)

theorem assumes wf: "wwf_J_prog P"
shows red_preserves_iconf:
  "P  e,(h,l,sh),b  e',(h',l',sh'),b'  iconf sh e  iconf sh' e'"
and reds_preserves_iconf:
  "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  iconfs sh es  iconfs sh' es'"
(*<*)
proof (induct rule:red_reds_inducts)
  case (BinOpRed1 e h l sh b e' h' l' sh' b' bop e2)
  then show ?case using BinOpRed1 nsub_RI_iconf[of e2 sh'] val_of_spec
  proof(cases "val_of e") qed(simp,fast)
next
  case (FAssRed1 e h l sh b e' h' l' sh' b' F D e2)
  then show ?case using FAssRed1 nsub_RI_iconf[of e2 sh'] val_of_spec
  proof(cases "val_of e") qed(simp,fast)
next
  case (CallObj e h l sh b e' h' l' sh' b' M es)
  then show ?case using CallObj nsub_RIs_iconfs[of es sh'] val_of_spec
  proof(cases "val_of e") qed(simp,fast)
next
  case RedCall then show ?case using sees_wwf_nsub_RI[OF wf RedCall.hyps(2)]
    by (clarsimp simp: assigned_def nsub_RI_iconf)
next
  case (RedSCall C M Ts T pns body D vs a a b)
  then have "¬sub_RI (blocks (pns, Ts, vs, body))"
    using sees_wwf_nsub_RI[OF wf RedSCall.hyps(1)] by simp
  then show ?case by(rule nsub_RI_iconf)
next
  case SCallInitRed then show ?case by fastforce
next
  case (BlockRedNone e h l V sh b e' h' l' sh' b' T)
  then show ?case by auto
next
  case (SeqRed e h l sh b e' h' l' sh' b' e2)
  then show ?case
  proof(cases "lass_val_of e")
    case None then show ?thesis using SeqRed nsub_RI_iconf by(auto dest: val_of_spec)
  next
    case (Some a)
    have "e' = unit  sh' = sh" by(simp add: lass_val_of_red[OF Some SeqRed(1)])
    then show ?thesis using SeqRed Some by(auto dest: val_of_spec)
  qed
next
  case (ListRed1 e h l sh b e' h' l' sh' b' es)
  then show ?case using ListRed1 nsub_RIs_iconfs[of es sh'] val_of_spec
  proof(cases "val_of e") qed(simp,fast)
next
  case RedInit then show ?case by(auto simp: nsub_RI_iconf)
next
  case (RedInitDone sh C sfs C' Cs e h l b)
  then show ?case proof(cases Cs) qed(auto simp: initPD_def)
next
  case (RedInitProcessing sh C sfs C' Cs e h l b)
  then show ?case proof(cases Cs) qed(auto simp: initPD_def)
next
  case (RedRInit sh C sfs i sh' C' Cs v e h l b)
  then show ?case proof(cases Cs) qed(auto simp: initPD_def)
next
  case CallThrowParams then show ?case by(auto simp: iconfs_map_throw)
next
  case SCallThrowParams then show ?case by(auto simp: iconfs_map_throw)
qed(auto simp: nsub_RI_iconf lass_val_of_iconf)
(*>*)


lemma Seq_bconf_preserve_aux:
assumes "P  e,(h, l, sh),b  e',(h', l', sh'),b'" and "P,sh b (e;; e2,b) "
  and "P,sh b (e::expr,b)   P,sh' b (e'::expr,b') "
shows "P,sh' b (e';;e2,b') "
proof(cases "val_of e")
  case None show ?thesis
  proof(cases "lass_val_of e")
    case lNone: None show ?thesis
    proof(cases "lass_val_of e'")
      case lNone': None
      then show ?thesis using None assms lNone
        by(auto dest: val_of_spec simp: bconf_def option.distinct(1))
    next
      case (Some a)
      then show ?thesis using None assms lNone by(auto dest: lass_val_of_spec simp: bconf_def)
    qed
  next
    case (Some a)
    then show ?thesis using None assms by(auto dest: lass_val_of_spec)
  qed
next
  case (Some a)
  then show ?thesis using assms by(auto dest: val_of_spec)
qed

theorem red_preserves_bconf:
  "P  e,(h,l,sh),b  e',(h',l',sh'),b'  iconf sh e  P,sh b (e,b)   P,sh' b (e',b') "
and reds_preserves_bconf:
  "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  iconfs sh es  P,sh b (es,b)   P,sh' b (es',b') "
(*<*)
proof (induct rule:red_reds_inducts)
  case (CastRed e a a b b e' a a b b' C) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (BinOpRed1 e h l sh b e' h' l' sh' b' bop e2) show ?case
  proof(cases b')
    case True with BinOpRed1 val_of_spec show ?thesis
    proof(cases "val_of e") qed(simp,fast)
  next
    case False then show ?thesis by (simp add: bconf_def)
  qed
next
case (BinOpRed2 e a a b b e' a a b b' v1 bop) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (LAssRed e a a b b e' a a b b' V) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (FAccRed e a a b b e' a a b b' F D) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (RedSFAccNonStatic C F t D h l sh b) then show ?case
    using has_field_fun[of P C F NonStatic] by (auto simp: bconf_def)
next
  case (FAssRed1 e h l sh b e' h' l' sh' b' F D e2) show ?case
  proof(cases b')
    case True with FAssRed1 val_of_spec show ?thesis
    proof(cases "val_of e'")qed((simp,fast)+)
  next
    case False then show ?thesis by(simp add: bconf_def)
  qed
next
  case (FAssRed2 e a a b b e' a a b b' v F D) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (SFAssRed e h l sh b e' h' l' sh' b' C F D) then show ?case
  proof(cases b') qed(fastforce simp: bconf_def val_no_step)+
next
  case (RedSFAssNonStatic C F t D v a a b b) then show ?case
    using has_field_fun[of P C F NonStatic] by (auto simp: bconf_def)
next
  case (CallObj e h l sh b e' h' l' sh' b' M es) show ?case
  proof(cases b')
    case True with CallObj val_of_spec show ?thesis
    proof(cases "val_of e'")qed((simp,fast)+)
  next
    case False then show ?thesis by(simp add: bconf_def)
  qed
next
  case (CallParams es a a b b es' a a b b' v M) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (SCallParams es h l sh b es' h' l' sh' b' C M) show ?case
  proof(cases b')
    case b': True show ?thesis
    proof(cases "map_vals_of es'")
      case None
      then show ?thesis using SCallParams b' vals_no_step
      proof(cases "map_vals_of es")qed(clarsimp,fast)
    next
      case f: Some
      then show ?thesis using SCallParams b' vals_no_step
      proof(cases "map_vals_of es")qed(clarsimp,fast)
    qed
  next
    case False then show ?thesis by(simp add: bconf_def)
  qed
next
  case (SCallInitDoneRed C M Ts T pns body D sh sfs vs h l)
    then show ?case by(auto simp: bconf_def initPD_def) (rule_tac x=D in exI, auto)+
next
  case (RedSCallNonStatic C M Ts T a b D vs h l sh b) then show ?case
    using sees_method_fun[of P C M NonStatic] by (auto simp: bconf_def)
next
  case (BlockRedNone e h l V sh b e' h' l' sh' b' T) show ?case
  proof(cases "assigned V e'")
    case True
    then obtain v e2 where "e' = V := Val v;;e2" by(clarsimp simp: assigned_def)
    then show ?thesis using BlockRedNone by(clarsimp simp: bconf_def)
  next
    case False then show ?thesis using BlockRedNone by simp
  qed
next
  case (BlockRedSome e h l V sh b e' h' l' sh' b' v T) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T) show ?case
  proof(cases b')
    case True
    then show ?thesis using InitBlockRed by (simp add: assigned_def)
  next
    case False then show ?thesis by(simp add: bconf_def)
  qed
next
  case (RedBlock V T u)
  then have "¬assigned V (Val u)" by(clarsimp simp: assigned_def)
  then show ?case using RedBlock by(simp add: bconf_def)
next
  case (SeqRed e h l sh b e' h' l' sh' b' e2)
  have "iconf sh e"
  proof(cases "lass_val_of e")
    case (Some a) show ?thesis by(rule lass_val_of_iconf[OF Some])
  next
    case None then show ?thesis using SeqRed by(auto dest: val_of_spec)
  qed
  then show ?case using SeqRed Seq_bconf_preserve_aux by simp
next
  case (CondRed e a a b b e' a a b b' e1 e2) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (ThrowRed e a a b b e' a a b b') then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (TryRed e a a b b e' a a b b' C V e2) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (ListRed1 e h l sh b e' h' l' sh' b' es)
  with val_of_spec show ?case
  proof(cases b') qed((clarsimp,fast),simp add: bconfs_def)
next
  case (RedInit C b' e X Y b b'')
  then show ?case
   by(auto simp: bconf_def icheck_ss_exp icheck_init_class icheck_curr_init)
next
  case (RInitRed e a a b b e' a a b b' C Cs e0) then show ?case
  proof(cases b') qed(simp, simp add: bconf_def)
next
  case (BlockThrow V T a)
  then have "¬assigned V (Throw a)" by(simp add: assigned_def)
  then show ?case using BlockThrow by simp
qed(simp_all, auto simp: bconf_def initPD_def)
(*>*)

text‹ Preservation of definite assignment more complex and requires a
few lemmas first. ›

lemma [iff]: "A.  length Vs = length Ts; length vs = length Ts 
 𝒟 (blocks (Vs,Ts,vs,e)) A = 𝒟 e (A  set Vs)"
(*<*)
apply(induct Vs Ts vs e rule:blocks_induct)
apply(simp_all add:hyperset_defs)
done
(*>*)


lemma red_lA_incr: "P  e,(h,l,sh),b  e',(h',l',sh'),b'
    dom l  𝒜 e   dom l'  𝒜 e'"
and reds_lA_incr: "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'
    dom l  𝒜s es   dom l'  𝒜s es'"
(*<*)
apply(induct rule:red_reds_inducts)
apply(simp_all del:fun_upd_apply add:hyperset_defs)
apply auto
apply(blast dest:red_lcl_incr)+
done
(*>*)

text‹ Now preservation of definite assignment. ›

lemma assumes wf: "wf_J_prog P"
shows red_preserves_defass:
  "P  e,(h,l,sh),b  e',(h',l',sh'),b'  𝒟 e dom l  𝒟 e' dom l'"
and "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  𝒟s es dom l  𝒟s es' dom l'"
(*<*)
proof (induct rule:red_reds_inducts)
  case BinOpRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case FAssRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case CallObj thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
next
  case RedCall thus ?case
    by (auto dest!:sees_wf_mdecl[OF wf] simp:wf_mdecl_def hyperset_defs elim!:D_mono')
next
  case RedSCall thus ?case
    by (auto dest!:sees_wf_mdecl[OF wf] simp:wf_mdecl_def hyperset_defs elim!:D_mono')
next
  case SCallInitRed
  then show ?case by(auto simp:hyperset_defs Ds_Vals)
next
  case InitBlockRed thus ?case
    by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
  case BlockRedNone thus ?case
    by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
  case BlockRedSome thus ?case
    by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
  case SeqRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case CondRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case TryRed thus ?case
    by (fastforce dest:red_lcl_incr intro:D_mono' simp:hyperset_defs)
next
  case ListRed1 thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
next
  case RedWhile thus ?case by(auto simp:hyperset_defs elim!:D_mono')
next
  case RedInit then show ?case by (auto intro: D_mono' simp: hyperset_defs)
next
  case (RInitRed e h l sh b e' h' l' sh' b' C Cs e0)
  then show ?case by(auto simp:hyperset_defs dest:red_lcl_incr elim!:D_mono')
qed(auto simp:hyperset_defs)
(*>*)


text‹ Combining conformance of heap, static heap, and local variables: ›

definition sconf :: "J_prog  env  state  bool"   ("_,_  _ "   [51,51,51]50)
where
  "P,E  s     let (h,l,sh) = s in P  h   P,h  l (:≤) E  P,h s sh "

lemma red_preserves_sconf:
  " P  e,s,b  e',s',b'; P,E,hp s,shp s  e : T; P,E  s    P,E  s' "
(*<*)
by(fastforce intro:red_preserves_hconf red_preserves_lconf red_preserves_shconf
            simp add:sconf_def)
(*>*)

lemma reds_preserves_sconf:
  " P  es,s,b [→] es',s',b'; P,E,hp s,shp s  es [:] Ts; P,E  s    P,E  s' "
(*<*)
by(fastforce intro:reds_preserves_hconf reds_preserves_lconf reds_preserves_shconf
            simp add:sconf_def)
(*>*)


subsection "Subject reduction"

lemma wt_blocks:
 "E.  length Vs = length Ts; length vs = length Ts  
       (P,E,h,sh  blocks(Vs,Ts,vs,e) : T) =
       (P,E(Vs[↦]Ts),h,sh  e:T  (Ts'. map (typeofh) vs = map Some Ts'  P  Ts' [≤] Ts))"
(*<*)
apply(induct Vs Ts vs e rule:blocks_induct)
apply (force simp add:rel_list_all2_Cons2)
apply simp_all
done
(*>*)

theorem assumes wf: "wf_J_prog P"
shows subject_reduction2: "P  e,(h,l,sh),b  e',(h',l',sh'),b' 
  (E T.  P,E  (h,l,sh) ; iconf sh e; P,E,h,sh  e:T 
            T'. P,E,h',sh'  e':T'  P  T'  T)"
and subjects_reduction2: "P  es,(h,l,sh),b [→] es',(h',l',sh'),b' 
  (E Ts.  P,E  (h,l,sh) ; iconfs sh es; P,E,h,sh  es [:] Ts 
             Ts'. P,E,h',sh'  es' [:] Ts'  P  Ts' [≤] Ts)"
(*<*)
proof (induct rule:red_reds_inducts)
  case RedNew then show ?case by (auto simp: blank_def)
next
  case RedNewFail thus ?case
    by (unfold sconf_def hconf_def) (fastforce elim!:typeof_OutOfMemory)
next
  case CastRed thus ?case
    by(clarsimp simp:is_refT_def)
      (blast intro: widens_trans dest!:widen_Class[THEN iffD1])
next
  case RedCastFail thus ?case
    by (unfold sconf_def hconf_def)  (fastforce elim!:typeof_ClassCast)
next
  case (BinOpRed1 e1 h l sh b e1' h' l' sh' b' bop e2)
  have red: "P  e1,(h,l,sh),b  e1',(h',l',sh'),b'"
   and IH: "E T. P,E  (h,l,sh) ; iconf sh e1; P,E,h,sh  e1:T
                  U. P,E,h',sh'  e1' : U  P  U  T"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (e1 «bop» e2)"
   and wt: "P,E,h,sh  e1 «bop» e2 : T" by fact+
  have val: "val_of e1 = None" using red iconf val_no_step by auto
  then have iconf1: "iconf sh e1" and nsub_RI2: "¬sub_RI e2" using iconf by simp+
  have "P,E,h',sh'  e1' «bop» e2 : T"
  proof (cases bop)
    assume [simp]: "bop = Eq"
    from wt obtain T1 T2 where [simp]: "T = Boolean"
      and wt1: "P,E,h,sh  e1 : T1" and wt2: "P,E,h,sh  e2 : T2" by auto
    show ?thesis
      using WTrt_hext_shext_mono[OF wt2 red_hext_incr[OF red] red_shext_incr[OF red wt1] nsub_RI2]
        IH[OF conf iconf1 wt1] by auto
  next
    assume  [simp]: "bop = Add"
    from wt have [simp]: "T = Integer"
      and wt1: "P,E,h,sh  e1 : Integer" and wt2: "P,E,h,sh  e2 : Integer"
      by auto
    show ?thesis
      using WTrt_hext_shext_mono[OF wt2 red_hext_incr[OF red] red_shext_incr[OF red wt1] nsub_RI2]
        IH[OF conf iconf1 wt1] by auto
  qed
  thus ?case by auto
next
  case (BinOpRed2 e2 h l sh b e2' h' l' sh' b' v1 bop)
  have red: "P  e2,(h,l,sh),b  e2',(h',l',sh'),b'"
   and IH: "E T. P,E  (h,l,sh) ; iconf sh e2; P,E,h,sh  e2:T
                  U. P,E,h',sh'  e2' : U  P  U  T"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (Val v1 «bop» e2)"
   and wt: "P,E,h,sh  (Val v1) «bop» e2 : T" by fact+
  have iconf2: "iconf sh e2" using iconf by simp
  have "P,E,h',sh'  (Val v1) «bop» e2' : T"
  proof (cases bop)
    assume [simp]: "bop = Eq"
    from wt obtain T1 T2 where [simp]: "T = Boolean"
      and wt1: "P,E,h,sh  Val v1 : T1" and wt2: "P,E,h,sh  e2:T2" by auto
    show ?thesis
      using IH[OF conf iconf2 wt2] WTrt_hext_mono[OF wt1 red_hext_incr[OF red]]
      by auto
  next
    assume  [simp]: "bop = Add"
    from wt have [simp]: "T = Integer"
      and wt1: "P,E,h,sh  Val v1 : Integer" and wt2: "P,E,h,sh  e2 : Integer"
      by auto
    show ?thesis
      using IH[OF conf iconf2 wt2] WTrt_hext_mono[OF wt1 red_hext_incr[OF red]]
      by auto
  qed
  thus ?case by auto
next
  case (RedBinOp bop) thus ?case
  proof (cases bop)
    case Eq thus ?thesis using RedBinOp by auto
  next
    case Add thus ?thesis using RedBinOp by auto
  qed
next
  case RedVar thus ?case by (fastforce simp:sconf_def lconf_def conf_def)
next
  case (LAssRed e h l sh b e' h' l' sh' b' V)
  obtain Te where Te: "P,E,h,sh  e : Te  P  Te  the(E V)" using LAssRed.prems(3) by auto
  then have wide: "P  Te  the(E V)" using LAssRed by simp
  then have "T'. P,E,h',sh'  e' : T'  P  T'  Te"
    using LAssRed.hyps(2) LAssRed.prems(1,2) Te widen_trans[OF _ wide] by auto
  then obtain T' where wt: "P,E,h',sh'  e' : T'  P  T'  Te" by clarsimp
  have "P,E,h',sh'  V:=e' : Void" using LAssRed wt widen_trans[OF _ wide] by auto
  then show ?case using LAssRed by(rule_tac x = Void in exI) auto
next
  case (FAccRed e h l sh b e' h' l' sh' b' F D)
  have IH: "E T. P,E  (h,l,sh) ; iconf sh e; P,E,h,sh  e : T
                  U. P,E,h',sh'  e' : U  P  U  T"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (eF{D})"
   and wt: "P,E,h,sh  eF{D} : T" by fact+
  have iconf': "iconf sh e" using iconf by simp+
  ― ‹The goal: ?case = @{prop ?case}›
  ― ‹Now distinguish the two cases how wt can have arisen.›
  { fix C assume wte: "P,E,h,sh  e : Class C"
             and has: "P  C has F,NonStatic:T in D"
    from IH[OF conf iconf' wte]
    obtain U where wte': "P,E,h',sh'  e' : U" and UsubC: "P  U  Class C"
      by auto
    ― ‹Now distinguish what @{term U} can be.›
    { assume "U = NT" hence ?case using wte'
        by(blast intro:WTrtFAccNT widen_refl) }
    moreover
    { fix C' assume U: "U = Class C'" and C'subC: "P  C' * C"
      from has_field_mono[OF has C'subC] wte' U
      have ?case by(blast intro:WTrtFAcc) }
    ultimately have ?case using UsubC by(simp add: widen_Class) blast }
  moreover
  { assume "P,E,h,sh  e : NT"
    hence "P,E,h',sh'  e' : NT" using IH[OF conf iconf'] by fastforce
    hence ?case  by(fastforce intro:WTrtFAccNT widen_refl) }
  ultimately show ?case using wt by blast
next
  case RedFAcc thus ?case
    by(fastforce simp:sconf_def hconf_def oconf_def conf_def has_field_def
                dest:has_fields_fun)
next
  case RedFAccNull thus ?case
    by(fastforce intro: widen_refl WTThrow[OF WTVal] elim!: typeof_NullPointer
                simp: sconf_def hconf_def)
next
  case RedSFAccNone then show ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoSuchFieldError
      simp: sconf_def hconf_def)
next
  case RedFAccStatic then show ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
      simp: sconf_def hconf_def)
next
  case (RedSFAcc C F t D sh sfs i v h l es)
  then have "P  C has F,Static:T in D" by fast
  then have dM: "P  D has F,Static:T in D" by(rule has_field_idemp)
  then show ?case using RedSFAcc by(fastforce simp:sconf_def shconf_def soconf_def conf_def)
next
  case SFAccInitDoneRed then show ?case by (meson widen_refl)
next
  case (SFAccInitRed C F t D sh h l E T)
  have "is_class P D" using SFAccInitRed.hyps(1) by(rule has_field_is_class')
  then have "P,E,h,sh  INIT D ([D],False)  CsF{D} : T  P  T  T"
    using SFAccInitRed WTrtInit[OF SFAccInitRed.prems(3)] by clarsimp
  then show ?case by(rule exI)
next
  case RedSFAccNonStatic then show ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
      simp: sconf_def hconf_def)
next
  case (FAssRed1 e h l sh b e' h' l' sh' b' F D e2)
  have red: "P  e,(h,l,sh),b  e',(h',l',sh'),b'"
   and IH: "E T. P,E  (h,l,sh) ; iconf sh e; P,E,h,sh  e : T
                  U. P,E,h',sh'  e' : U  P  U  T"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (eF{D} := e2)"
   and wt: "P,E,h,sh  eF{D}:=e2 : T" by fact+
  have val: "val_of e = None" using red iconf val_no_step by auto
  then have iconf': "iconf sh e" and nsub_RI2: "¬sub_RI e2" using iconf by simp+
  from wt have void: "T = Void" by blast
  ― ‹We distinguish if @{term e} has type @{term NT} or a Class type›
  ― ‹Remember ?case = @{term ?case}›
  { assume wt':"P,E,h,sh  e : NT"
    hence "P,E,h',sh'  e' : NT" using IH[OF conf iconf'] by fastforce
    moreover obtain T2 where "P,E,h,sh  e2 : T2" using wt by auto
    from this red_hext_incr[OF red] red_shext_incr[OF red wt'] nsub_RI2 have  "P,E,h',sh'  e2 : T2"
      by(rule WTrt_hext_shext_mono)
    ultimately have ?case using void by(blast intro!:WTrtFAssNT)
  }
  moreover
  { fix C TF T2 assume wt1: "P,E,h,sh  e : Class C" and wt2: "P,E,h,sh  e2 : T2"
    and has: "P  C has F,NonStatic:TF in D" and sub: "P  T2  TF"
    obtain U where wt1': "P,E,h',sh'  e' : U" and UsubC: "P  U  Class C"
      using IH[OF conf iconf' wt1] by blast
    have wt2': "P,E,h',sh'  e2 : T2"
      by(rule WTrt_hext_shext_mono[OF wt2 red_hext_incr[OF red] red_shext_incr[OF red wt1] nsub_RI2])
    ― ‹Is @{term U} the null type or a class type?›
    { assume "U = NT" with wt1' wt2' void have ?case
        by(blast intro!:WTrtFAssNT) }
    moreover
    { fix C' assume UClass: "U = Class C'" and "subclass": "P  C' * C"
      have "P,E,h',sh'  e' : Class C'" using wt1' UClass by auto
      moreover have "P  C' has F,NonStatic:TF in D"
        by(rule has_field_mono[OF has "subclass"])
      ultimately have ?case using wt2' sub void by(blast intro:WTrtFAss) }
    ultimately have ?case using UsubC by(auto simp add:widen_Class) }
  ultimately show ?case using wt by blast
next
  case (FAssRed2 e2 h l sh b e2' h' l' sh' b' v F D)
  have red: "P  e2,(h,l,sh),b  e2',(h',l',sh'),b'"
   and IH: "E T. P,E  (h,l,sh) ; iconf sh e2; P,E,h,sh  e2 : T
                  U. P,E,h',sh'  e2' : U  P  U  T"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (Val vF{D} := e2)"
   and wt: "P,E,h,sh  Val vF{D}:=e2 : T" by fact+
  have iconf2: "iconf sh e2" using iconf by simp
  from wt have [simp]: "T = Void" by auto
  from wt show ?case
  proof (rule WTrt_elim_cases)
    fix C TF T2
    assume wt1: "P,E,h,sh  Val v : Class C"
      and has: "P  C has F,NonStatic:TF in D"
      and wt2: "P,E,h,sh  e2 : T2" and TsubTF: "P  T2  TF"
    have wt1': "P,E,h',sh'  Val v : Class C"
      using WTrt_hext_mono[OF wt1 red_hext_incr[OF red]] by auto
    obtain T2' where wt2': "P,E,h',sh'  e2' : T2'" and T'subT: "P  T2'  T2"
      using IH[OF conf iconf2 wt2] by blast
    have "P,E,h',sh'  Val vF{D}:=e2' : Void"
      by(rule WTrtFAss[OF wt1' has wt2' widen_trans[OF T'subT TsubTF]])
    thus ?case by auto
  next
    fix T2 assume null: "P,E,h,sh  Val v : NT" and wt2: "P,E,h,sh  e2 : T2"
    from null have "v = Null" by simp
    moreover
    obtain T2' where "P,E,h',sh'  e2' : T2'  P  T2'  T2"
      using IH[OF conf iconf2 wt2] by blast
    ultimately show ?thesis by(fastforce intro:WTrtFAssNT)
  qed
next
  case RedFAss thus ?case by(auto simp del:fun_upd_apply)
next
  case RedFAssNull thus ?case
    by(fastforce intro: WTThrow[OF WTVal] elim!:typeof_NullPointer simp:sconf_def hconf_def)
next
  case RedFAssStatic then show ?case 
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
      simp: sconf_def hconf_def)
next
  case (SFAssRed e h l sh b e' h' l' sh' b' C F D E T)
  have IH: "E T. P,E  (h,l,sh) ; iconf sh e; P,E,h,sh  e : T
                  U. P,E,h',sh'  e' : U  P  U  T"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (CsF{D} := e)"
   and wt: "P,E,h,sh  CsF{D}:=e : T" by fact+
  have iconf': "iconf sh e" using iconf by simp
  from wt have [simp]: "T = Void" by auto
  from wt show ?case
  proof (rule WTrt_elim_cases)
    fix TF T1
    assume has: "P  C has F,Static:TF in D"
      and wt1: "P,E,h,sh  e : T1" and TsubTF: "P  T1  TF"
    obtain T' where wt1': "P,E,h',sh'  e' : T'" and T'subT: "P  T'  T1"
      using IH[OF conf iconf' wt1] by blast
    have "P,E,h',sh'  CsF{D}:=e' : Void"
      by(rule WTrtSFAss[OF wt1' has widen_trans[OF T'subT TsubTF]])
    thus ?case by auto
  qed
next
  case SFAssInitDoneRed then show ?case by (meson widen_refl)
next
  case (SFAssInitRed C F t D sh v h l E T)
  have "is_class P D" using SFAssInitRed.hyps(1) by(rule has_field_is_class')
  then have "P,E,h,sh  INIT D ([D],False)  CsF{D} := Val v : T  P  T  T"
    using SFAssInitRed WTrtInit[OF SFAssInitRed.prems(3)] by clarsimp
  then show ?case by(rule exI)
next
  case RedSFAssNone then show ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoSuchFieldError
      simp: sconf_def hconf_def)
next
  case RedSFAssNonStatic then show ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
      simp: sconf_def hconf_def)
next
  case (CallObj e h l sh b e' h' l' sh' b' M es)
  have red: "P  e,(h,l,sh),b  e',(h',l',sh'),b'"
   and IH: "E T. P,E  (h,l,sh) ; iconf sh e; P,E,h,sh  e : T
                  U. P,E,h',sh'  e' : U  P  U  T"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (eM(es))"
   and wt: "P,E,h,sh  eM(es) : T" by fact+
  have val: "val_of e = None" using red iconf val_no_step by auto
  then have iconf': "iconf sh e" and nsub_RIs: "¬sub_RIs es" using iconf by simp+
  ― ‹We distinguish if @{term e} has type @{term NT} or a Class type›
  ― ‹Remember ?case = @{term ?case}›
  { assume wt':"P,E,h,sh  e:NT"
    hence "P,E,h',sh'  e' : NT" using IH[OF conf iconf'] by fastforce
    moreover
    fix Ts assume wtes: "P,E,h,sh  es [:] Ts"
    have "P,E,h',sh'  es [:] Ts"
      by(rule WTrts_hext_shext_mono[OF wtes red_hext_incr[OF red] red_shext_incr[OF red wt'] nsub_RIs])
    ultimately have ?case by(blast intro!:WTrtCallNT) }
  moreover
  { fix C D Ts Us pns body
    assume wte: "P,E,h,sh  e : Class C"
      and "method": "P  C sees M,NonStatic:TsT = (pns,body) in D"
      and wtes: "P,E,h,sh  es [:] Us" and subs: "P  Us [≤] Ts"
    obtain U where wte': "P,E,h',sh'  e' : U" and UsubC: "P  U  Class C"
      using IH[OF conf iconf' wte] by blast
    ― ‹Is @{term U} the null type or a class type?›
    { assume "U = NT"
      moreover have "P,E,h',sh'  es [:] Us"
        by(rule WTrts_hext_shext_mono[OF wtes red_hext_incr[OF red] red_shext_incr[OF red wte] nsub_RIs])
      ultimately have ?case using wte' by(blast intro!:WTrtCallNT) }
    moreover
    { fix C' assume UClass: "U = Class C'" and "subclass": "P  C' * C"
      have "P,E,h',sh'  e' : Class C'" using wte' UClass by auto
      moreover obtain Ts' T' pns' body' D'
        where method': "P  C' sees M,NonStatic:Ts'T' = (pns',body') in D'"
        and subs': "P  Ts [≤] Ts'" and sub': "P  T'  T"
        using Call_lemma[OF "method" "subclass" wf] by fast
      moreover have "P,E,h',sh'  es [:] Us"
        by(rule WTrts_hext_shext_mono[OF wtes red_hext_incr[OF red] red_shext_incr[OF red wte] nsub_RIs])
      ultimately have ?case
        using subs by(blast intro:WTrtCall rtrancl_trans widens_trans) }
    ultimately have ?case using UsubC by(auto simp add:widen_Class) }
  ultimately show ?case using wt by auto
next
  case (CallParams es h l sh b es' h' l' sh' b' v M)
  have reds: "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'"
   and IH: "E Ts. P,E  (h,l,sh) ; iconfs sh es; P,E,h,sh  es [:] Ts
                  Us. P,E,h',sh'  es' [:] Us  P  Us [≤] Ts"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (Val vM(es))"
   and wt: "P,E,h,sh  Val vM(es) : T" by fact+
  have iconfs: "iconfs sh es" using iconf by simp
  from wt show ?case
  proof (rule WTrt_elim_cases)
    fix C D Ts Us pns body
    assume wte: "P,E,h,sh  Val v : Class C"
      and "P  C sees M,NonStatic:TsT = (pns,body) in D"
      and wtes: "P,E,h,sh  es [:] Us" and "P  Us [≤] Ts"
    moreover have "P,E,h',sh'  Val v : Class C"
      using WTrt_hext_mono[OF wte reds_hext_incr[OF reds]] by auto
    moreover
    obtain Us' where "P,E,h',sh'  es' [:] Us'  P  Us' [≤] Us"
      using IH[OF conf iconfs wtes] by blast
    ultimately show ?thesis by(blast intro:WTrtCall widens_trans)
  next
    fix Us
    assume null: "P,E,h,sh  Val v : NT" and wtes: "P,E,h,sh  es [:] Us"
    from null have "v = Null" by simp
    moreover
    obtain Us' where "P,E,h',sh'  es' [:] Us'  P  Us' [≤] Us"
      using IH[OF conf iconfs wtes] by blast
    ultimately show ?thesis by(fastforce intro:WTrtCallNT)
  qed
next
  case (RedCall h a C fs M Ts T pns body D vs l sh b E T')
  have hp: "h a = Some(C,fs)"
   and "method": "P  C sees M,NonStatic: TsT = (pns,body) in D"
   and wt: "P,E,h,sh  addr aM(map Val vs) : T'" by fact+
  obtain Ts' where wtes: "P,E,h,sh  map Val vs [:] Ts'"
    and subs: "P  Ts' [≤] Ts" and T'isT: "T' = T"
    using wt "method" hp by (auto dest:sees_method_fun)
  from wtes subs have length_vs: "length vs = length Ts"
    by(fastforce simp:list_all2_iff dest!:WTrts_same_length)
  from sees_wf_mdecl[OF wf "method"] obtain T''
    where wtabody: "P,[this#pns [↦] Class D#Ts]  body :: T''"
    and T''subT: "P  T''  T" and length_pns: "length pns = length Ts"
    by(fastforce simp:wf_mdecl_def simp del:map_upds_twist)
  from wtabody have "P,Map.empty(this#pns [↦] Class D#Ts),h,sh  body : T''"
    by(rule WT_implies_WTrt)
  hence "P,E(this#pns [↦] Class D#Ts),h,sh  body : T''"
    by(rule WTrt_env_mono) simp
  hence "P,E,h,sh  blocks(this#pns, Class D#Ts, Addr a#vs, body) : T''"
  using wtes subs hp sees_method_decl_above[OF "method"] length_vs length_pns
    by(fastforce simp add:wt_blocks rel_list_all2_Cons2)
  with T''subT T'isT show ?case by blast
next
  case RedCallNull thus ?case
    by(fastforce intro: WTThrow[OF WTVal] elim!:typeof_NullPointer simp: sconf_def hconf_def)
next
  case RedCallStatic then show ?case 
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
      simp: sconf_def hconf_def)
next
  case (SCallParams es h l sh b es' h' l' sh' b' C M)
  have IH: "E Ts. P,E  (h,l,sh) ; iconfs sh es; P,E,h,sh  es [:] Ts
                  Us. P,E,h',sh'  es' [:] Us  P  Us [≤] Ts"
   and conf: "P,E  (h,l,sh) " and iconf: "iconf sh (CsM(es))"
   and wt: "P,E,h,sh  CsM(es) : T" by fact+
  have iconfs: "iconfs sh es" using iconf by simp
  from wt show ?case
  proof (rule WTrt_elim_cases)
    fix D Ts Us pns body sfs vs
    assume method: "P  C sees M,Static:TsT = (pns,body) in D"
      and wtes: "P,E,h,sh  es [:] Us" and us: "P  Us [≤] Ts"
      and clinit: "M = clinit  sh D = (sfs,Processing)  es = map Val vs"
    obtain Us' where es': "P,E,h',sh'  es' [:] Us'" and us': "P  Us' [≤] Us"
      using IH[OF conf iconfs wtes] by blast
    show ?thesis
    proof(cases "M = clinit")
      case True then show ?thesis using clinit SCallParams.hyps(1) by blast
    next
      case False
      then show ?thesis using es' method us us' by(blast intro:WTrtSCall widens_trans)
    qed
  qed
next
  case (RedSCall C M Ts T pns body D vs h l sh E T')
  have "method": "P  C sees M,Static: TsT = (pns,body) in D"
   and wt: "P,E,h,sh  CsM(map Val vs) : T'" by fact+
  obtain Ts' where wtes: "P,E,h,sh  map Val vs [:] Ts'"
    and subs: "P  Ts' [≤] Ts" and T'isT: "T' = T"
    using wt "method" map_Val_eq by(auto dest:sees_method_fun)+
  from wtes subs have length_vs: "length vs = length Ts"
    by(fastforce simp:list_all2_iff dest!:WTrts_same_length)
  from sees_wf_mdecl[OF wf "method"] obtain T''
    where wtabody: "P,[pns [↦] Ts]  body :: T''"
    and T''subT: "P  T''  T" and length_pns: "length pns = length Ts"
    by(fastforce simp:wf_mdecl_def simp del:map_upds_twist)
  from wtabody have "P,Map.empty(pns [↦] Ts),h,sh  body : T''"
    by(rule WT_implies_WTrt)
  hence "P,E(pns [↦] Ts),h,sh  body : T''"
    by(rule WTrt_env_mono) simp
  hence "P,E,h,sh  blocks(pns, Ts, vs, body) : T''"
  using wtes subs sees_method_decl_above[OF "method"] length_vs length_pns
    by(fastforce simp add:wt_blocks rel_list_all2_Cons2)
  with T''subT T'isT show ?case by blast
next
  case SCallInitDoneRed then show ?case by (meson widen_refl)
next
  case (SCallInitRed C F Ts t pns body D sh v h l E T)
  have "is_class P D" using SCallInitRed.hyps(1) by(rule sees_method_is_class')
  then have "P,E,h,sh  INIT D ([D],False)  CsF(map Val v) : T  P  T  T"
    using SCallInitRed WTrtInit[OF SCallInitRed.prems(3)] by clarsimp
  then show ?case by(rule exI)
next
  case RedSCallNone then show ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoSuchMethodError
      simp: sconf_def hconf_def)
next
  case RedSCallNonStatic then show ?case 
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
      simp: sconf_def hconf_def)
next
  case BlockRedNone thus ?case
    by(auto simp del:fun_upd_apply)(fastforce simp:sconf_def lconf_def)
next
  case (BlockRedSome e h l V sh b e' h' l' sh' b' v T E Te)
  have red: "P  e,(h,l(V:=None),sh),b  e',(h',l',sh'),b'"
   and IH: "E T. P,E  (h,l(V:=None),sh) ; iconf sh e; P,E,h,sh  e : T
                    T'. P,E,h',sh'  e' : T'  P  T'  T"
   and Some: "l' V = Some v" and conf: "P,E  (h,l,sh) "
   and iconf: "iconf sh {V:T; e}"
   and wt: "P,E,h,sh  {V:T; e} : Te" by fact+
  obtain Te' where IH': "P,E(VT),h',sh'  e' : Te'  P  Te'  Te"
    using IH conf iconf wt by(fastforce simp:sconf_def lconf_def)
  have "P,h'  l' (:≤) E(VT)" using conf wt
    by(fastforce intro:red_preserves_lconf[OF red] simp:sconf_def lconf_def)
  hence "P,h'  v :≤ T" using Some by(fastforce simp:lconf_def)
  with IH' show ?case
    by(fastforce simp:sconf_def conf_def fun_upd_same simp del:fun_upd_apply)
next
  case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T E T')
  have red: "P  e, (h,l(Vv),sh),b  e',(h',l',sh'),b'"
   and IH: "E T. P,E  (h,l(Vv),sh) ; iconf sh e; P,E,h,sh  e : T
                     U. P,E,h',sh'  e' : U  P  U  T"
   and v': "l' V = Some v'" and conf: "P,E  (h,l,sh) "
   and iconf: "iconf sh {V:T; V:=Val v;; e}"
   and wt: "P,E,h,sh  {V:T := Val v; e} : T'" by fact+
  from wt obtain T1 where wt1: "typeofh v = Some T1"
    and T1subT: "P  T1  T" and wt2: "P,E(VT),h,sh  e : T'" by auto
  have lconf2: "P,h  l(Vv) (:≤) E(VT)" using conf wt1 T1subT
    by(simp add:sconf_def lconf_upd2 conf_def)
  have "T1'. typeofh' v' = Some T1'  P  T1'  T"
    using v' red_preserves_lconf[OF red wt2 lconf2]
    by(fastforce simp:lconf_def conf_def)
  with IH conf iconf lconf2 wt2 show ?case by (fastforce simp add:sconf_def)
next
  case (SeqRed e h l sh b e' h' l' sh' b' e2)
  then have val: "val_of e = None" by (simp add: val_no_step)
  show ?case
  proof(cases "lass_val_of e")
    case None
    then show ?thesis
      using SeqRed val by(auto elim: WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])
  next
    case (Some a)
    have "sh = sh'" using SeqRed lass_val_of_spec[OF Some] by auto
    then show ?thesis using SeqRed val Some
      by(auto intro: lass_val_of_iconf[OF Some] elim: WTrt_hext_mono[OF _ red_hext_incr])
  qed
next
  case CondRed thus ?case
    by auto (blast intro:WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])+
next
  case ThrowRed thus ?case
    by(auto simp:is_refT_def)(blast dest:widen_Class[THEN iffD1])+
next
  case RedThrowNull thus ?case
    by(fastforce intro: WTThrow[OF WTVal] elim!:typeof_NullPointer simp:sconf_def hconf_def)
next
  case TryRed thus ?case
    by auto (blast intro:widen_trans WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])
next
  case RedTryFail thus ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] simp:sconf_def hconf_def)
next
  case (ListRed1 e h l sh b e' h' l' sh' b' es)
    then have val: "val_of e = None" by(simp add: val_no_step)
    obtain U Us where Ts: "Ts = U # Us" using ListRed1 by auto
    then have nsub_RI: "¬ sub_RIs es" and wts: "P,E,h,sh  es [:] Us" and wt: "P,E,h,sh  e : U"
     and IH: "E T. P,E  (h, l, sh) ; P,E,h,sh  e : T  T'. P,E,h',sh'  e' : T'  P  T'  T"
      using ListRed1 val by auto
    obtain T' where
    "E0 E1. (T2. P,E1,h',sh'  e' : T2  P  T2  E0) = (P,E1,h',sh'  e' : T' E0 E1  P  T' E0 E1  E0)"
      by moura
    then have disj: "E t. ¬ P,E  (h, l, sh)   ¬ P,E,h,sh  e : t  P,E,h',sh'  e' : T' t E  P  T' t E  t"
      using IH by presburger
    have "P,E,h',sh'  es [:] Us"
      using nsub_RI wts wt by (metis (no_types) ListRed1.hyps(1) WTrts_hext_shext_mono red_hext_incr red_shext_incr)
    then have "ts. (t tsa. ts = t # tsa  P,E,h',sh'  e' : t  P,E,h',sh'  es [:] tsa)  P  ts [≤] (U # Us)"
      using disj wt ListRed1.prems(1) by blast
    then show ?case using Ts by auto
next
  case ListRed2 thus ?case
    by(fastforce dest: hext_typeof_mono[OF reds_hext_incr])
next
  case (InitNoneRed sh C C' Cs e h l b)
  then have sh: "sh s sh(C  (sblank P C, Prepared))" by(simp add: shext_def)
  have wt: "P,E,h,sh(C  (sblank P C, Prepared))  INIT C' (C # Cs,False)  e : T"
      using InitNoneRed WTrt_shext_mono[OF _ sh] by fastforce
  then show ?case by(rule_tac x = T in exI) (simp add: fun_upd_def)
next
  case (RedInitDone sh C sfs C' Cs e h l b)
  then have "P,E,h,sh  INIT C' (Cs,True)  e : T" by auto (metis Nil_tl list.set_sel(2))
  then show ?case by(rule_tac x = T in exI) simp
next
  case (RedInitProcessing sh C sfs C' Cs e h l b)
  then have "P,E,h,sh  INIT C' (Cs,True)  e : T" by auto (metis Nil_tl list.set_sel(2))+
  then show ?case by(rule_tac x = T in exI) simp
next
  case RedInitError then show ?case
    by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoClassDefFoundError
      simp: sconf_def hconf_def)
next
  case (InitObjectRed sh C sfs sh' C' Cs e h l b)
  then have sh: "sh s sh(Object  (sfs, Processing))" by(simp add: shext_def)
  have "P,E,h,sh'  INIT C' (C # Cs,True)  e : T"
    using InitObjectRed WTrt_shext_mono[OF _ sh] by auto
  then show ?case by(rule_tac x = T in exI) (simp add: fun_upd_def)
next
  case (InitNonObjectSuperRed sh C sfs D fs ms sh' C' Cs e h l b)
  then have sh: "sh s sh(C  (sfs, Processing))" by(simp add: shext_def)
  then have cd: "is_class P D" using InitNonObjectSuperRed class_wf wf wf_cdecl_supD by blast
  have sup': "supercls_lst P (C # Cs)" using InitNonObjectSuperRed.prems(3) by auto
  then have sup: "supercls_lst P (D # C # Cs)"
    using supercls_lst_app[of P C Cs D] subcls1I[OF InitNonObjectSuperRed.hyps(3,2)] by auto
  have "distinct (C # Cs)" using InitNonObjectSuperRed.prems(3) by auto
  then have dist: "distinct (D # C # Cs)"
    using wf_supercls_distinct_app[OF wf InitNonObjectSuperRed.hyps(2-3) sup'] by simp
  have "P,E,h,sh'  INIT C' (D # C # Cs,False)  e : T"
    using InitNonObjectSuperRed WTrt_shext_mono[OF _ sh] cd sup dist by auto
  then show ?case by(rule_tac x = T in exI) simp
next
  case (RedInitRInit C' C Cs e' h l sh b E T)
  then obtain a sfs where C: "class P C = a" and proc: "sh C = (sfs, Processing)"
    using WTrtInit by(auto simp: is_class_def)
  then have T': "P,E,h,sh  Csclinit([]) : Void" using wf_types_clinit[OF wf C] by simp
  have "P,E,h,sh  RI (C,Csclinit([])) ; Cs  e' : T"
    using RedInitRInit by(auto intro: T')
  then show ?case by(rule_tac x = T in exI) simp
next
  case (RInitRed e h l sh b e' h' l' sh' b' C Cs e0 E T)
  then have "(E T. P,E  (h, l, sh)   P,E,h,sh  e : T  T'. P,E,h',sh'  e' : T'  P  T'  T)"
    by auto
  then have "T'. P,E,h',sh'  e' : T'" using RInitRed by blast
  then obtain T' where e': "P,E,h',sh'  e' : T'" by auto
  have wt0: "P,E,h',sh'  e0 : T"
   using RInitRed by simp (auto intro: WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])
  have nip: "C'  set (C#Cs). not_init C' e'  (sfs. sh' C' = (sfs, Processing))"
   using RInitRed red_proc_pres[OF wf_prog_wwf_prog[OF wf]] by auto
  have shC: "sfs. sh' C = (sfs, Processing)  sh' C = (sfs, Error)  e' = THROW NoClassDefFoundError"
    using RInitRed red_proc_pres[OF wf_prog_wwf_prog[OF wf] RInitRed.hyps(1)] by blast
  have "P,E,h',sh'  RI (C,e') ; Cs  e0 : T" using RInitRed e' wt0 nip shC by auto
  then show ?case by(rule_tac x = T in exI) simp
next
  case (RedRInit sh C sfs i sh' C' Cs v e h l b)
  then have sh: "sh s sh(C  (sfs, Done))" by(auto simp: shext_def)
  have wt: "P,E,h,sh(C  (sfs, Done))  e : T"
    using RedRInit WTrt_shext_mono[OF _ sh] by auto
  have shC: "C'  set(tl Cs). sfs. sh C' = (sfs, Processing)" using RedRInit by(cases Cs, auto)
  have "P,E,h,sh'  INIT C' (Cs,True)  e : T" using RedRInit wt shC by(cases Cs, auto)
  then show ?case by(rule_tac x = T in exI) simp
next
  case (SCallThrowParams es vs e es' C M h l sh b)
    then show ?case using map_Val_nthrow_neq[of _ vs e es'] by fastforce
next
  case (RInitInitThrow sh C sfs i sh' a D Cs e h l b)
  then have sh: "sh s sh(C  (sfs, Error))" by(auto simp: shext_def)
  have wt: "P,E,h,sh(C  (sfs, Error))  e : T"
   using RInitInitThrow WTrt_shext_mono[OF _ sh] by clarsimp
  then have "P,E,h,sh'  RI (D,Throw a) ; Cs  e : T" using RInitInitThrow by auto
  then show ?case by(rule_tac x = T in exI) simp
qed fastforce+ (* esp all Throw propagation rules except RInitInit are dealt with here *)
(*>*)


corollary subject_reduction:
  " wf_J_prog P; P  e,s,b  e',s',b'; P,E  s ; iconf (shp s) e; P,E,hp s,shp s  e:T 
   T'. P,E,hp s',shp s'  e':T'  P  T'  T"
(*<*)by(cases s, cases s', fastforce dest:subject_reduction2)(*>*)

corollary subjects_reduction:
  " wf_J_prog P; P  es,s,b [→] es',s',b'; P,E  s ; iconfs (shp s) es; P,E,hp s,shp s  es[:]Ts 
   Ts'. P,E,hp s',shp s'  es'[:]Ts'  P  Ts' [≤] Ts"
(*<*)by(cases s, cases s', fastforce dest:subjects_reduction2)(*>*)


subsection ‹ Lifting to @{text"→*"}

text‹ Now all these preservation lemmas are first lifted to the transitive
closure \dots ›

lemma Red_preserves_sconf:
assumes wf: "wf_J_prog P" and Red: "P  e,s,b →* e',s',b'"
shows "T.  P,E,hp s,shp s  e : T; iconf (shp s) e; P,E  s    P,E  s' "
(*<*)
using Red
proof (induct rule:converse_rtrancl_induct3)
  case refl show ?case by fact
next
  case (step e s b e' s' b')
  obtain h l sh h' l' sh' where s:"s = (h,l,sh)" and s':"s' = (h',l',sh')"
    by(cases s, cases s')
  then have "P  e,(h,l,sh),b  e',(h',l',sh'),b'" using step.hyps(1) by simp
  then have iconf': "iconf (shp s') e'" using red_preserves_iconf[OF wf_prog_wwf_prog[OF wf]]
    step.prems(2) s s' by simp
  thus ?case using step
    by(blast intro:red_preserves_sconf dest: subject_reduction[OF wf])
qed
(*>*)

lemma Red_preserves_iconf:
assumes wf: "wwf_J_prog P" and Red: "P  e,s,b →* e',s',b'"
shows "iconf (shp s) e  iconf (shp s') e'"
(*<*)
using Red
proof (induct rule:converse_rtrancl_induct3)
  case refl show ?case by fact
next
  case (step e s b e' s' b')
  thus ?case using wf step by(cases s, cases s', simp) (blast intro:red_preserves_iconf)
qed
(*>*)

lemma Reds_preserves_iconf:
assumes wf: "wwf_J_prog P" and Red: "P  es,s,b [→]* es',s',b'"
shows "iconfs (shp s) es  iconfs (shp s') es'"
(*<*)
using Red
proof (induct rule:converse_rtrancl_induct3)
  case refl show ?case by fact
next
  case (step e s b e' s' b')
  thus ?case using wf step by(cases s, cases s', simp) (blast intro:reds_preserves_iconf)
qed
(*>*)

lemma Red_preserves_bconf:
assumes wf: "wwf_J_prog P" and Red: "P  e,s,b →* e',s',b'"
shows "iconf (shp s) e  P,(shp s) b (e,b)   P,(shp s') b (e'::expr,b') "
(*<*)
using Red
proof (induct rule:converse_rtrancl_induct3)
  case refl show ?case by fact
next
  case (step e s1 b e' s2 b')
  then have "iconf (shp s2) e'" using step red_preserves_iconf[OF wf]
   by(cases s1, cases s2) auto
  thus ?case using step by(cases s1, cases s2, simp) (blast intro:red_preserves_bconf)
qed
(*>*)

lemma Reds_preserves_bconf:
assumes wf: "wwf_J_prog P" and Red: "P  es,s,b [→]* es',s',b'"
shows "iconfs (shp s) es  P,(shp s) b (es,b)   P,(shp s') b (es'::expr list,b') "
(*<*)
using Red
proof (induct rule:converse_rtrancl_induct3)
  case refl show ?case by fact
next
  case (step es s1 b es' s2 b')
  then have "iconfs (shp s2) es'" using step reds_preserves_iconf[OF wf]
   by(cases s1, cases s2) auto
  thus ?case using step by(cases s1, cases s2, simp) (blast intro:reds_preserves_bconf)
qed
(*>*)

lemma Red_preserves_defass:
assumes wf: "wf_J_prog P" and reds: "P  e,s,b →* e',s',b'"
shows "𝒟 e dom(lcl s)  𝒟 e' dom(lcl s')"
using reds
proof (induct rule:converse_rtrancl_induct3)
  case refl thus ?case .
next
  case (step e s b e' s' b') thus ?case
    by(cases s,cases s')(auto dest:red_preserves_defass[OF wf])
qed


lemma Red_preserves_type:
assumes wf: "wf_J_prog P" and Red: "P  e,s,b →* e',s',b'"
shows "!!T.  P,E  s; iconf (shp s) e; P,E,hp s,shp s  e:T 
     T'. P  T'  T  P,E,hp s',shp s'  e':T'"
(*<*)
using Red
proof (induct rule:converse_rtrancl_induct3)
  case refl thus ?case by blast
next
  case step thus ?case
    by(blast intro:widen_trans red_preserves_sconf Red_preserves_iconf[OF wf_prog_wwf_prog[OF wf]]
             dest:subject_reduction[OF wf])
qed
(*>*)


subsection "The final polish"

text‹ The above preservation lemmas are now combined and packed nicely. ›

definition wf_config :: "J_prog  env  state  expr  ty  bool"   ("_,_,_  _ : _ "   [51,0,0,0,0]50)
where
  "P,E,s  e:T     P,E  s   iconf (shp s) e  P,E,hp s,shp s  e:T"

theorem Subject_reduction: assumes wf: "wf_J_prog P"
shows "P  e,s,b  e',s',b'  P,E,s  e : T 
        T'. P,E,s'  e' : T'   P  T'  T"
(*<*)
by(cases s, cases s')
  (force simp: wf_config_def
         elim:red_preserves_sconf red_preserves_iconf[OF wf_prog_wwf_prog[OF wf]]
         dest:subject_reduction[OF wf])
(*>*)


theorem Subject_reductions:
assumes wf: "wf_J_prog P" and reds: "P  e,s,b →* e',s',b'"
shows "T. P,E,s  e:T   T'. P,E,s'  e':T'   P  T'  T"
(*<*)
using reds
proof (induct rule:converse_rtrancl_induct3)
  case refl thus ?case by blast
next
  case step thus ?case
    by(blast dest:Subject_reduction[OF wf] intro:widen_trans)
qed
(*>*)


corollary Progress: assumes wf: "wf_J_prog P"
shows " P,E,s   e : T ; 𝒟 e dom(lcl s); P,shp s b (e,b) ; ¬ final e 
    e' s' b'. P  e,s,b  e',s',b'"
(*<*)
using progress[OF wf_prog_wwf_prog[OF wf]]
by(cases b) (auto simp:wf_config_def sconf_def)
(*>*)

corollary TypeSafety:
  " wf_J_prog P; P,E  s ; P,E  e::T; 𝒟 e dom(lcl s);
     iconf (shp s) e; P,(shp s) b (e,b) ;
     P  e,s,b →* e',s',b'; ¬(e'' s'' b''. P  e',s',b'  e'',s'',b'') 
  (v. e' = Val v  P,hp s'  v :≤ T) 
      (a. e' = Throw a  a  dom(hp s'))"
(*<*)
apply(subgoal_tac "wwf_J_prog P")
 prefer 2 apply(rule wf_prog_wwf_prog, simp)
apply(subgoal_tac " P,E,s  e:T ")
 prefer 2
 apply(fastforce simp:wf_config_def dest:WT_implies_WTrt)
apply(frule (2) Subject_reductions)
apply(erule exE conjE)+
apply(frule (2) Red_preserves_defass)
apply(frule (3) Red_preserves_bconf)
apply(subgoal_tac "final e'")
 prefer 2
 apply(blast dest: Progress)
apply (fastforce simp:wf_config_def final_def conf_def dest: Progress)
done
(*>*)


end

Theory Equivalence

(*  Title:      JinjaDCI/J/Equivalence.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/Equivalence.thy by Tobias Nipkow
*)

section ‹ Equivalence of Big Step and Small Step Semantics ›

theory Equivalence imports TypeSafe WWellForm begin

subsection‹Small steps simulate big step›

subsubsection "Init"

text "The reduction of initialization expressions doesn't touch or use
 their on-hold expressions (the subexpression to the right of @{text })
 until the initialization operation completes. This function is used to prove
 this and related properties. It is then used for general reduction of
 initialization expressions separately from their on-hold expressions by
 using the on-hold expression @{term unit}, then putting the real on-hold
 expression back in at the end."

fun init_switch :: "'a exp  'a exp  'a exp" where
"init_switch (INIT C (Cs,b)  ei) e = (INIT C (Cs,b)  e)" |
"init_switch (RI(C,e');Cs  ei) e = (RI(C,e');Cs  e)" |
"init_switch e' e = e'"

fun INIT_class :: "'a exp  cname option" where
"INIT_class (INIT C (Cs,b)  e) = (if C = last (C#Cs) then Some C else None)" |
"INIT_class (RI(C,e0);Cs  e) = Some (last (C#Cs))" |
"INIT_class _ = None"

lemma init_red_init:
" init_exp_of e0 = e; P  e0,s0,b0  e1,s1,b1 
   (init_exp_of e1 = e  (INIT_class e0 = C  INIT_class e1 = C))
    (e1 = e  b1 = icheck P (the(INIT_class e0)) e)  (a. e1 = throw a)"
 by(erule red.cases, auto)

lemma init_exp_switch[simp]:
"init_exp_of e0 = e  init_exp_of (init_switch e0 e') = e'"
 by(cases e0, simp_all)

lemma init_red_sync:
" P  e0,s0,b0  e1,s1,b1; init_exp_of e0 = e; e1  e 
   (e'. P  init_switch e0 e',s0,b0  init_switch e1 e',s1,b1)"
proof(induct rule: red.cases) qed(simp_all add: red_reds.intros)

lemma init_red_sync_end:
" P  e0,s0,b0  e1,s1,b1; init_exp_of e0 = e; e1 = e; throw_of e = None 
   (e'. ¬sub_RI e'  P  init_switch e0 e',s0,b0  e',s1,icheck P (the(INIT_class e0)) e')"
proof(induct rule: red.cases) qed(simp_all add: red_reds.intros)

lemma init_reds_sync_unit':
 " P  e0,s0,b0 →* Val v',s1,b1; init_exp_of e0 = unit; INIT_class e0 = C 
   (e'. ¬sub_RI e'  P  init_switch e0 e',s0,b0 →* e',s1,icheck P (the(INIT_class e0)) e')"
proof(induct rule:converse_rtrancl_induct3)
case refl then show ?case by simp
next
  case (step e0 s0 b0 e1 s1 b1)
  have "(init_exp_of e1 = unit  (INIT_class e0 = C  INIT_class e1 = C))
           (e1 = unit  b1 = icheck P (the(INIT_class e0)) unit)  (a. e1 = throw a)"
    using init_red_init[OF step.prems(1) step.hyps(1)] by simp
  then show ?case
  proof(rule disjE)
    assume assm: "init_exp_of e1 = unit  (INIT_class e0 = C  INIT_class e1 = C)"
    then have red: "P  init_switch e0 e',s0,b0  init_switch e1 e',s1,b1"
      using init_red_sync[OF step.hyps(1) step.prems(1)] by simp
    have reds: "P  init_switch e1 e',s1,b1 →* e',s1,icheck P (the (INIT_class e0)) e'"
      using step.hyps(3)[OF _ _ step.prems(3)] assm step.prems(2) by simp
    show ?thesis by(rule converse_rtrancl_into_rtrancl[OF red reds])
  next
    assume "(e1 = unit  b1 = icheck P (the(INIT_class e0)) unit)  (a. e1 = throw a)"
    then show ?thesis
    proof(rule disjE)
      assume assm: "e1 = unit  b1 = icheck P (the(INIT_class e0)) unit" then have e1: "e1 = unit" by simp
      have sb: "s1 = s1" "b1 = b1" using reds_final_same[OF step.hyps(2)] assm
        by(simp_all add: final_def)
      then have step': "P  init_switch e0 e',s0,b0  e',s1,icheck P (the (INIT_class e0)) e'"
        using init_red_sync_end[OF step.hyps(1) step.prems(1) e1 _ step.prems(3)] by auto
      then have "P  init_switch e0 e',s0,b0 →* e',s1,icheck P (the (INIT_class e0)) e'"
        using r_into_rtrancl by auto
      then show ?thesis using step assm sb by simp
    next
      assume "a. e1 = throw a" then obtain a where "e1 = throw a" by clarsimp
      then have tof: "throw_of e1 = a" by simp
      then show ?thesis using reds_throw[OF step.hyps(2) tof] by simp
    qed
  qed
qed

lemma init_reds_sync_unit_throw':
 " P  e0,s0,b0 →* throw a,s1,b1; init_exp_of e0 = unit 
   (e'. P  init_switch e0 e',s0,b0 →* throw a,s1,b1)"
proof(induct rule:converse_rtrancl_induct3)
case refl then show ?case by simp
next
  case (step e0 s0 b0 e1 s1 b1)
  have "init_exp_of e1 = unit  (C. INIT_class e0 = C  INIT_class e1 = C) 
  e1 = unit  b1 = icheck P (the (INIT_class e0)) unit  (a. e1 = throw a)"
    using init_red_init[OF step.prems(1) step.hyps(1)] by auto
  then show ?case
  proof(rule disjE)
    assume assm: "init_exp_of e1 = unit  (C. INIT_class e0 = C  INIT_class e1 = C)"
    then have "P  init_switch e0 e',s0,b0  init_switch e1 e',s1,b1"
      using step init_red_sync[OF step.hyps(1) step.prems] by simp
    then show ?thesis using step assm by (meson converse_rtrancl_into_rtrancl)
  next
    assume "e1 = unit  b1 = icheck P (the (INIT_class e0)) unit  (a. e1 = throw a)"
    then show ?thesis
    proof(rule disjE)
      assume "e1 = unit  b1 = icheck P (the (INIT_class e0)) unit"
      then show ?thesis using step using final_def reds_final_same by blast
    next
      assume assm: "a. e1 = throw a"
      then have "P  init_switch e0 e',s0,b0  e1,s1,b1"
        using init_red_sync[OF step.hyps(1) step.prems] by clarsimp
      then show ?thesis using step by simp
    qed
  qed
qed

lemma init_reds_sync_unit:
assumes "P  e0,s0,b0 →* Val v',s1,b1" and "init_exp_of e0 = unit" and "INIT_class e0 = C"
  and "¬sub_RI e'"
shows "P  init_switch e0 e',s0,b0 →* e',s1,icheck P (the(INIT_class e0)) e'"
using init_reds_sync_unit'[OF assms] by clarsimp

lemma init_reds_sync_unit_throw:
assumes "P  e0,s0,b0 →* throw a,s1,b1" and "init_exp_of e0 = unit"
shows "P  init_switch e0 e',s0,b0 →* throw a,s1,b1"
using init_reds_sync_unit_throw'[OF assms] by clarsimp

― ‹ init reds lemmas ›

lemma InitSeqReds:
assumes "P  INIT C ([C],b)  unit,s0,b0 →* Val v',s1,b1"
 and "P  e,s1,icheck P C e →* e2,s2,b2" and "¬sub_RI e"
shows "P  INIT C ([C],b)  e,s0,b0 →* e2,s2,b2"
using assms
proof -
  have "P  init_switch (INIT C ([C],b)  unit) e,s0,b0 →* e,s1,icheck P C e"
    using init_reds_sync_unit[OF assms(1) _ _ assms(3)] by simp
  then show ?thesis using assms(2) by simp
qed

lemma InitSeqThrowReds:
assumes "P  INIT C ([C],b)  unit,s0,b0 →* throw a,s1,b1"
shows "P  INIT C ([C],b)  e,s0,b0 →* throw a,s1,b1"
using assms
proof -
  have "P  init_switch (INIT C ([C],b)  unit) e,s0,b0 →* throw a,s1,b1"
    using init_reds_sync_unit_throw[OF assms(1)] by simp
  then show ?thesis by simp
qed

lemma InitNoneReds:
 " sh C = None;
    P  INIT C' (C # Cs,False)  e,(h, l, sh(C  (sblank P C, Prepared))),b →* e',s',b' 
 P  INIT C' (C#Cs,False)  e,(h,l,sh),b →* e',s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule InitNoneRed)
apply assumption
done
(*>*)

lemma InitDoneReds:
 " sh C = Some(sfs,Done); P  INIT C' (Cs,True)  e,(h,l,sh),b →* e',s',b' 
 P  INIT C' (C#Cs,False)  e,(h,l,sh),b →* e',s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule RedInitDone)
apply assumption
done
(*>*)

lemma InitProcessingReds:
 " sh C = Some(sfs,Processing); P  INIT C' (Cs,True)  e,(h,l,sh),b →* e',s',b' 
 P  INIT C' (C#Cs,False)  e,(h,l,sh),b →* e',s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule RedInitProcessing)
apply assumption
done
(*>*)

lemma InitErrorReds:
 " sh C = Some(sfs,Error); P  RI (C,THROW NoClassDefFoundError);Cs  e,(h,l,sh),b →* e',s',b' 
 P  INIT C' (C#Cs,False)  e,(h,l,sh),b →* e',s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule RedInitError)
apply assumption
done
(*>*)

lemma InitObjectReds:
 " sh C = Some(sfs,Prepared); C = Object; sh' = sh(C  (sfs,Processing));
    P  INIT C' (C#Cs,True)  e,(h,l,sh'),b →* e',s',b' 
 P  INIT C' (C#Cs,False)  e,(h,l,sh),b →* e',s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule (2) InitObjectRed)
apply assumption
done
(*>*)

lemma InitNonObjectReds:
 " sh C = Some(sfs,Prepared); C  Object; class P C = Some (D,r);
    sh' = sh(C  (sfs,Processing));
    P  INIT C' (D#C#Cs,False)  e,(h,l,sh'),b →* e',s',b' 
 P  INIT C' (C#Cs,False)  e,(h,l,sh),b →* e',s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule (3) InitNonObjectSuperRed)
apply assumption
done
(*>*)

lemma RedsInitRInit:
 "P  RI (C,Csclinit([]));Cs  e,(h,l,sh),b →* e',s',b'
 P  INIT C' (C#Cs,True)  e,(h,l,sh),b →* e',s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedInitRInit)
apply assumption
done
(*>*)

lemmas rtrancl_induct3 =
  rtrancl_induct[of "(ax,ay,az)" "(bx,by,bz)", split_format (complete), consumes 1, case_names refl step]

lemma RInitReds:
 "P  e,s,b →* e',s',b'
 P  RI (C,e);Cs  e0, s, b →* RI (C,e');Cs  e0, s', b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule RInitRed)
done
(*>*)

lemma RedsRInit:
 " P  e0,s0,b0 →* Val v,(h1,l1,sh1),b1;
    sh1 C = Some (sfs, i); sh2 = sh1(C  (sfs,Done)); C' = last(C#Cs);
    P  INIT C' (Cs,True)  e,(h1,l1,sh2),b1 →* e',s',b' 
 P  RI (C, e0);Cs  e,s0,b0 →* e',s',b'"
(*<*)
apply(rule rtrancl_trans)
 apply(erule RInitReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule (2) RedRInit)
apply assumption
done
(*>*)

lemma RInitInitThrowReds:
  " P  e,s,b →* Throw a, (h',l',sh'),b';
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Error));
     P  RI (D,Throw a);Cs  e0, (h',l',sh''),b' →* e1,s1,b1 
   P  RI (C,e);D#Cs  e0,s,b →* e1,s1,b1"
(*<*)
apply(rule rtrancl_trans)
 apply(erule RInitReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule (1) RInitInitThrow)
apply assumption
done
(*>*)

lemma RInitThrowReds:
  " P  e,s,b →* Throw a, (h',l',sh'),b';
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Error)) 
   P  RI (C,e);Nil  e0,s,b →* Throw a, (h',l',sh''),b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule RInitReds)
apply(erule RInitThrow)
apply assumption
done
(*>*)

subsubsection "New"

lemma NewInitDoneReds:
  " sh C = Some (sfs, Done); new_Addr h = Some a;
     P  C has_fields FDTs; h' = h(ablank P C) 
    P  new C,(h,l,sh),False →* addr a,(h',l,sh),False"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule NewInitDoneRed)
apply(rule r_into_rtrancl)
apply(erule (2) RedNew)
done
(*>*)

lemma NewInitDoneReds2:
  " sh C = Some (sfs, Done); new_Addr h = None; is_class P C 
    P  new C,(h,l,sh),False →* THROW OutOfMemory, (h,l,sh), False"
(*<*)
apply(rule_tac converse_rtrancl_into_rtrancl)
 apply(erule NewInitDoneRed)
apply(rule r_into_rtrancl)
apply(erule (1) RedNewFail)
done
(*>*)

lemma NewInitReds:
 " sfs. shp s C = Some (sfs, Done);
    P  INIT C ([C],False)  unit,s,False →* Val v',(h',l',sh'),b';
    new_Addr h' = Some a; P  C has_fields FDTs; h'' = h'(ablank P C); is_class P C 
   P  new C,s,False →* addr a,(h'',l',sh'),False"
(*<*)
apply(rule_tac b = "(INIT C ([C],False)  new C,s,False)" in converse_rtrancl_into_rtrancl)
 apply(cases s, simp)
 apply (simp add: NewInitRed)
apply(erule InitSeqReds, simp_all)
apply(rule r_into_rtrancl, rule RedNew)
  apply simp+
done
(*>*)

lemma NewInitOOMReds:
 " sfs. shp s C = Some (sfs, Done);
    P  INIT C ([C],False)  unit,s,False →* Val v',(h',l',sh'),b';
    new_Addr h' = None; is_class P C 
   P  new C,s,False →* THROW OutOfMemory,(h',l',sh'),False"
(*<*)
apply(rule_tac b = "(INIT C ([C],False)  new C,s,False)" in converse_rtrancl_into_rtrancl)
 apply(cases s, simp)
 apply (simp add: NewInitRed)
apply(erule InitSeqReds, simp_all)
apply(rule r_into_rtrancl, rule RedNewFail)
 apply simp+
done
(*>*)

lemma NewInitThrowReds:
 " sfs. shp s C = Some (sfs, Done); is_class P C;
    P  INIT C ([C],False)  unit,s,False →* throw a,s',b' 
   P  new C,s,False →* throw a,s',b'"
(*<*)
apply(rule_tac b = "(INIT C ([C],False)  new C,s,False)" in converse_rtrancl_into_rtrancl)
 apply(cases s, simp)
 apply (simp add: NewInitRed)
apply(erule InitSeqThrowReds)
done
(*>*)

subsubsection "Cast"

lemma CastReds:
  "P  e,s,b →* e',s',b'  P  Cast C e,s,b →* Cast C e',s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CastRed)
done
(*>*)

lemma CastRedsNull:
  "P  e,s,b →* null,s',b'  P  Cast C e,s,b →* null,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule CastReds)
apply(rule RedCastNull)
done
(*>*)

lemma CastRedsAddr:
  " P  e,s,b →* addr a,s',b'; hp s' a = Some(D,fs); P  D * C  
  P  Cast C e,s,b →* addr a,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule CastReds)
apply(cases s',simp)
apply(erule (1) RedCast)
done
(*>*)

lemma CastRedsFail:
  " P  e,s,b →* addr a,s',b'; hp s' a = Some(D,fs); ¬ P  D * C  
  P  Cast C e,s,b →* THROW ClassCast,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule CastReds)
apply(cases s',simp)
apply(erule (1) RedCastFail)
done
(*>*)

lemma CastRedsThrow:
  " P  e,s,b →* throw a,s',b'   P  Cast C e,s,b →* throw a,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule CastReds)
apply(rule red_reds.CastThrow)
done
(*>*)

subsubsection "LAss"

lemma LAssReds:
  "P  e,s,b →* e',s',b'  P   V:=e,s,b →*  V:=e',s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule LAssRed)
done
(*>*)

lemma LAssRedsVal:
  " P  e,s,b →* Val v,(h',l',sh'),b'   P   V:=e,s,b →* unit,(h',l'(Vv),sh'),b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule LAssReds)
apply(rule RedLAss)
done
(*>*)

lemma LAssRedsThrow:
  " P  e,s,b →* throw a,s',b'   P   V:=e,s,b →* throw a,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule LAssReds)
apply(rule red_reds.LAssThrow)
done
(*>*)

subsubsection "BinOp"

lemma BinOp1Reds:
  "P  e,s,b →* e',s',b'  P   e «bop» e2, s,b →* e' «bop» e2, s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule BinOpRed1)
done
(*>*)

lemma BinOp2Reds:
  "P  e,s,b →* e',s',b'  P  (Val v) «bop» e, s,b →* (Val v) «bop» e', s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule BinOpRed2)
done
(*>*)

lemma BinOpRedsVal:
  " P  e1,s0,b0 →* Val v1,s1,b1; P  e2,s1,b1 →* Val v2,s2,b2; binop(bop,v1,v2) = Some v 
   P  e1 «bop» e2, s0,b0 →* Val v,s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
 apply(erule BinOp2Reds)
apply(rule RedBinOp)
apply simp
done
(*>*)

lemma BinOpRedsThrow1:
  "P  e,s,b →* throw e',s',b'  P  e «bop» e2, s,b →* throw e', s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule BinOp1Reds)
apply(rule red_reds.BinOpThrow1)
done
(*>*)

lemma BinOpRedsThrow2:
  " P  e1,s0,b0 →* Val v1,s1,b1; P  e2,s1,b1 →* throw e,s2,b2
   P  e1 «bop» e2, s0, b0 →* throw e,s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
 apply(erule BinOp2Reds)
apply(rule red_reds.BinOpThrow2)
done
(*>*)

subsubsection "FAcc"

lemma FAccReds:
  "P  e,s,b →* e',s',b'  P  eF{D}, s,b →* e'F{D}, s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule FAccRed)
done
(*>*)

lemma FAccRedsVal:
  " P  e,s,b →* addr a,s',b'; hp s' a = Some(C,fs); fs(F,D) = Some v;
    P  C has F,NonStatic:t in D 
   P  eF{D},s,b →* Val v,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply(cases s',simp)
apply(erule (2) RedFAcc)
done
(*>*)

lemma FAccRedsNull:
  "P  e,s,b →* null,s',b'  P  eF{D},s,b →* THROW NullPointer,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply(rule RedFAccNull)
done
(*>*)

lemma FAccRedsNone:
  " P  e,s,b →* addr a,s',b';
     hp s' a = Some(C,fs);
    ¬(b t. P  C has F,b:t in D) 
   P  eF{D},s,b →* THROW NoSuchFieldError,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply(cases s',simp)
apply(erule RedFAccNone, simp)
done
(*>*)

lemma FAccRedsStatic:
  " P  e,s,b →* addr a,s',b';
     hp s' a = Some(C,fs);
    P  C has F,Static:t in D 
   P  eF{D},s,b →* THROW IncompatibleClassChangeError,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply(cases s',simp)
apply(erule (1) RedFAccStatic)
done
(*>*)

lemma FAccRedsThrow:
  "P  e,s,b →* throw a,s',b'  P  eF{D},s,b →* throw a,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply(rule red_reds.FAccThrow)
done
(*>*)

subsubsection "SFAcc"

lemma SFAccReds:
  " P  C has F,Static:t in D;
     shp s D = Some(sfs,Done); sfs F = Some v 
   P  CsF{D},s,True →* Val v,s,False"
(*<*)
apply(rule r_into_rtrancl)
apply(cases s,simp)
apply(erule (2) RedSFAcc)
done
(*>*)

lemma SFAccRedsNone:
  "¬(b t. P  C has F,b:t in D)
   P  CsF{D},s,b →* THROW NoSuchFieldError,s,False"
(*<*)
apply(rule r_into_rtrancl)
apply(cases s,simp)
apply(rule RedSFAccNone, simp)
done
(*>*)

lemma SFAccRedsNonStatic:
  "P  C has F,NonStatic:t in D
   P  CsF{D},s,b →* THROW IncompatibleClassChangeError,s,False"
(*<*)
apply(rule r_into_rtrancl)
apply(cases s,simp)
apply(erule RedSFAccNonStatic)
done
(*>*)

lemma SFAccInitDoneReds:
  " P  C has F,Static:t in D;
     shp s D = Some (sfs,Done);
     sfs F = Some v 
  P  CsF{D}, s,b →* Val v, s,False"
(*<*)
apply(cases b)
― ‹ case True ›
 apply(rule r_into_rtrancl)
 apply(cases s, simp)
 apply(erule (2) RedSFAcc)
― ‹ case False ›
apply(rule_tac b = "(CsF{D},s,True)" in converse_rtrancl_into_rtrancl)
 apply(cases s, simp)
 apply(drule (2) SFAccInitDoneRed)
apply(erule SFAccReds, simp+)
done
(*>*)

lemma SFAccInitReds:
  " P  C has F,Static:t in D;
     sfs. shp s D = Some (sfs,Done);
     P  INIT D ([D],False)  unit,s,False →* Val v',s',b';
     shp s' D = Some (sfs,i); sfs F = Some v 
  P  CsF{D},s,False →* Val v,s',False"
(*<*)
apply(rule_tac b = "(INIT D ([D],False)  CsF{D},s,False)" in converse_rtrancl_into_rtrancl)
 apply(cases s, simp)
 apply(simp add: SFAccInitRed)
apply(rule InitSeqReds, simp_all)
apply(subgoal_tac "T. P  C has F,Static:T in D")
 prefer 2 apply fast
apply(rule r_into_rtrancl)
apply(cases s', simp)
apply(erule (2) RedSFAcc)
done
(*>*)

lemma SFAccInitThrowReds:
  " P  C has F,Static:t in D;
     sfs. shp s D = Some (sfs,Done);
     P  INIT D ([D],False)  unit,s,False →* throw a,s',b' 
  P  CsF{D},s,False →* throw a,s',b'"
(*<*)
apply(rule_tac b = "(INIT D ([D],False)  CsF{D},s,False)" in converse_rtrancl_into_rtrancl)
 apply(cases s, simp)
 apply (simp add: SFAccInitRed)
apply(erule InitSeqThrowReds)
done
(*>*)

subsubsection "FAss"

lemma FAssReds1:
  "P  e,s,b →* e',s',b'  P  eF{D}:=e2, s,b →* e'F{D}:=e2, s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule FAssRed1)
done
(*>*)

lemma FAssReds2:
  "P  e,s,b →* e',s',b'  P  Val vF{D}:=e, s,b →* Val vF{D}:=e', s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule FAssRed2)
done
(*>*)

lemma FAssRedsVal:
  " P  e1,s0,b0 →* addr a,s1,b1; P  e2,s1,b1 →* Val v,(h2,l2,sh2),b2;
    P  C has F,NonStatic:t in D; Some(C,fs) = h2 a  
  P  e1F{D}:=e2, s0,b0 →* unit, (h2(a(C,fs((F,D)v))),l2,sh2),b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(rule RedFAss)
 apply simp+
done
(*>*)

lemma FAssRedsNull:
  " P  e1,s0,b0 →* null,s1,b1; P  e2,s1,b1 →* Val v,s2,b2  
  P  e1F{D}:=e2, s0,b0 →* THROW NullPointer, s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(rule RedFAssNull)
done
(*>*)

lemma FAssRedsThrow1:
  "P  e,s,b →* throw e',s',b'  P  eF{D}:=e2, s,b →* throw e', s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds1)
apply(rule red_reds.FAssThrow1)
done
(*>*)

lemma FAssRedsThrow2:
  " P  e1,s0,b0 →* Val v,s1,b1; P  e2,s1,b1 →* throw e,s2,b2 
   P  e1F{D}:=e2,s0,b0 →* throw e,s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(rule red_reds.FAssThrow2)
done
(*>*)

lemma FAssRedsNone:
  " P  e1,s0,b0 →* addr a,s1,b1; P  e2,s1,b1 →* Val v,(h2,l2,sh2),b2;
     h2 a = Some(C,fs); ¬(b t. P  C has F,b:t in D)  
  P  e1F{D}:=e2, s0,b0 →* THROW NoSuchFieldError, (h2,l2,sh2),b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(rule RedFAssNone)
 apply simp+
done
(*>*)

lemma FAssRedsStatic:
  " P  e1,s0,b0 →* addr a,s1,b1; P  e2,s1,b1 →* Val v,(h2,l2,sh2),b2;
     h2 a = Some(C,fs); P  C has F,Static:t in D  
  P  e1F{D}:=e2, s0,b0 →* THROW IncompatibleClassChangeError, (h2,l2,sh2),b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(rule RedFAssStatic)
 apply simp+
done
(*>*)

subsubsection "SFAss"

lemma SFAssReds:
  "P  e,s,b →* e',s',b'  P  CsF{D}:=e,s,b →* CsF{D}:=e',s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule SFAssRed)
done
(*>*)

lemma SFAssRedsVal:
  " P  e2,s0,b0 →* Val v,(h2,l2,sh2),b2;
    P  C has F,Static:t in D; sh2 D = (sfs,Done)  
  P  CsF{D}:=e2, s0,b0 →* unit, (h2,l2,sh2(D(sfs(Fv), Done))),False"
(*<*)
apply(rule rtrancl_trans)
 apply(erule SFAssReds)
apply(cases b2)
― ‹ case True ›
 apply(rule r_into_rtrancl)
 apply(drule_tac l = l2 in RedSFAss, simp_all)
― ‹ case False ›
apply(rule converse_rtrancl_into_rtrancl)
 apply(drule_tac sh = sh2 in SFAssInitDoneRed, simp_all)
apply(rule r_into_rtrancl)
apply(drule_tac l = l2 in RedSFAss, simp_all)
done
(*>*)

lemma SFAssRedsThrow:
  " P  e2,s0,b0 →* throw e,s2,b2 
   P  CsF{D}:=e2,s0,b0 →* throw e,s2,b2"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule SFAssReds)
apply(rule red_reds.SFAssThrow)
done
(*>*)

lemma SFAssRedsNone:
  " P  e2,s0,b0 →* Val v,(h2,l2,sh2),b2;
     ¬(b t. P  C has F,b:t in D)  
  P  CsF{D}:=e2,s0,b0 →* THROW NoSuchFieldError, (h2,l2,sh2),False"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule SFAssReds)
apply(rule RedSFAssNone)
apply simp
done
(*>*)

lemma SFAssRedsNonStatic:
  " P  e2,s0,b0 →* Val v,(h2,l2,sh2),b2;
     P  C has F,NonStatic:t in D  
  P  CsF{D}:=e2,s0,b0 →* THROW IncompatibleClassChangeError,(h2,l2,sh2),False"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule SFAssReds)
apply(rule RedSFAssNonStatic)
apply simp
done
(*>*)

lemma SFAssInitReds:
 " P  e2,s0,b0 →* Val v,(h2,l2,sh2),False;
    P  C has F,Static:t in D;
    sfs. sh2 D = Some (sfs, Done);
    P  INIT D ([D],False)  unit,(h2,l2,sh2),False →* Val v',(h',l',sh'),b';
    sh' D = Some(sfs,i);
    sfs' = sfs(Fv); sh'' = sh'(D(sfs',i)) 
   P  CsF{D}:=e2,s0,b0 →* unit,(h',l',sh''),False"
(*<*)
apply(rule rtrancl_trans)
 apply(erule SFAssReds)
apply(rule_tac converse_rtrancl_into_rtrancl)
 apply(erule (1) SFAssInitRed)
apply(erule InitSeqReds, simp_all)
apply(subgoal_tac "T. P  C has F,Static:T in D")
 prefer 2 apply fast
apply(simp,rule r_into_rtrancl)
apply(erule (2) RedSFAss)
apply simp
done
(*>*)

lemma SFAssInitThrowReds:
 " P  e2,s0,b0 →* Val v,(h2,l2,sh2),False;
    P  C has F,Static:t in D;
    sfs. sh2 D = Some (sfs, Done);
    P  INIT D ([D],False)  unit,(h2,l2,sh2),False →* throw a,s',b' 
   P  CsF{D}:=e2,s0,b0 →* throw a,s',b'"
(*<*)
apply(rule rtrancl_trans)
 apply(erule SFAssReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(erule (1) SFAssInitRed)
apply(erule InitSeqThrowReds)
done
(*>*)

subsubsection";;"

lemma  SeqReds:
  "P  e,s,b →* e',s',b'  P  e;;e2, s,b →* e';;e2, s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule SeqRed)
done
(*>*)

lemma SeqRedsThrow:
  "P  e,s,b →* throw e',s',b'  P  e;;e2, s,b →* throw e', s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule SeqReds)
apply(rule red_reds.SeqThrow)
done
(*>*)

lemma SeqReds2:
  " P  e1,s0,b0 →* Val v1,s1,b1; P  e2,s1,b1 →* e2',s2,b2   P  e1;;e2, s0,b0 →* e2',s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule SeqReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedSeq)
apply assumption
done
(*>*)


subsubsection"If"

lemma CondReds:
  "P  e,s,b →* e',s',b'  P  if (e) e1 else e2,s,b →* if (e') e1 else e2,s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CondRed)
done
(*>*)

lemma CondRedsThrow:
  "P  e,s,b →* throw a,s',b'  P  if (e) e1 else e2, s,b →* throw a,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule CondReds)
apply(rule red_reds.CondThrow)
done
(*>*)

lemma CondReds2T:
  "P  e,s0,b0 →* true,s1,b1; P  e1, s1,b1 →* e',s2,b2   P  if (e) e1 else e2, s0,b0 →* e',s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedCondT)
apply assumption
done
(*>*)

lemma CondReds2F:
  "P  e,s0,b0 →* false,s1,b1; P  e2, s1,b1 →* e',s2,b2   P  if (e) e1 else e2, s0,b0 →* e',s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedCondF)
apply assumption
done
(*>*)


subsubsection "While"

lemma WhileFReds:
  "P  b,s,b0 →* false,s',b'  P  while (b) c,s,b0 →* unit,s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedWhile)
apply(rule rtrancl_into_rtrancl)
 apply(erule CondReds)
apply(rule RedCondF)
done
(*>*)

lemma WhileRedsThrow:
  "P  b,s,b0 →* throw e,s',b'  P  while (b) c,s,b0 →* throw e,s',b'"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedWhile)
apply(rule rtrancl_into_rtrancl)
 apply(erule CondReds)
apply(rule red_reds.CondThrow)
done
(*>*)

lemma WhileTReds:
  " P  b,s0,b0 →* true,s1,b1; P  c,s1,b1 →* Val v1,s2,b2; P  while (b) c,s2,b2 →* e,s3,b3 
   P  while (b) c,s0,b0 →* e,s3,b3"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedWhile)
apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedCondT)
apply(rule rtrancl_trans)
 apply(erule SeqReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedSeq)
apply assumption
done
(*>*)

lemma WhileTRedsThrow:
  " P  b,s0,b0 →* true,s1,b1; P  c,s1,b1 →* throw e,s2,b2 
   P  while (b) c,s0,b0 →* throw e,s2,b2"
(*<*)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedWhile)
apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedCondT)
apply(rule rtrancl_into_rtrancl)
 apply(erule SeqReds)
apply(rule red_reds.SeqThrow)
done
(*>*)

subsubsection"Throw"

lemma ThrowReds:
  "P  e,s,b →* e',s',b'  P  throw e,s,b →* throw e',s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule ThrowRed)
done
(*>*)

lemma ThrowRedsNull:
  "P  e,s,b →* null,s',b'  P  throw e,s,b →* THROW NullPointer,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule ThrowReds)
apply(rule RedThrowNull)
done
(*>*)

lemma ThrowRedsThrow:
  "P  e,s,b →* throw a,s',b'  P  throw e,s,b →* throw a,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule ThrowReds)
apply(rule red_reds.ThrowThrow)
done
(*>*)

subsubsection "InitBlock"

lemma InitBlockReds_aux:
  "P  e,s,b →* e',s',b' 
  h l sh h' l' sh' v. s = (h,l(Vv),sh)  s' = (h',l',sh') 
  P  {V:T := Val v; e},(h,l,sh),b →* {V:T := Val(the(l' V)); e'},(h',l'(V:=(l V)),sh'),b'"
(*<*)
apply(erule converse_rtrancl_induct3)
 apply(fastforce simp: fun_upd_same simp del:fun_upd_apply)
apply clarify
apply(rename_tac e0 X Y x3 b0 e1 h1 l1 sh1 b1 h0 l0 sh0 h2 l2 sh2 v0)
apply(subgoal_tac "V  dom l1")
 prefer 2
 apply(drule red_lcl_incr)
 apply simp
apply clarsimp
apply(rename_tac v1)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule InitBlockRed)
  apply assumption
 apply simp
apply(erule_tac x = "l1(V := l0 V)" in allE)
apply(erule_tac x = v1 in allE)
apply(erule impE)
 apply(rule ext)
 apply(simp add:fun_upd_def)
apply(simp add:fun_upd_def)
done
(*>*)

lemma InitBlockReds:
 "P  e, (h,l(Vv),sh),b →* e', (h',l',sh'),b' 
  P  {V:T := Val v; e}, (h,l,sh),b →* {V:T := Val(the(l' V)); e'}, (h',l'(V:=(l V)),sh'),b'"
(*<*)by(blast dest:InitBlockReds_aux)(*>*)

lemma InitBlockRedsFinal:
  " P  e,(h,l(Vv),sh),b →* e',(h',l',sh'),b'; final e'  
  P  {V:T := Val v; e},(h,l,sh),b →* e',(h', l'(V := l V),sh'),b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule InitBlockReds)
apply(fast elim!:finalE intro:RedInitBlock InitBlockThrow)
done
(*>*)


subsubsection "Block"

lemmas converse_rtranclE3 = converse_rtranclE [of "(xa,xb,xc)" "(za,zb,zc)", split_rule]

lemma BlockRedsFinal:
assumes reds: "P  e0,s0,b0 →* e2,(h2,l2,sh2),b2" and fin: "final e2"
shows "h0 l0 sh0. s0 = (h0,l0(V:=None),sh0)  P  {V:T; e0},(h0,l0,sh0),b0 →* e2,(h2,l2(V:=l0 V),sh2),b2"
(*<*)
using reds
proof (induct rule:converse_rtrancl_induct3)
  case refl thus ?case
    by(fastforce intro:finalE[OF fin] RedBlock BlockThrow
                simp del:fun_upd_apply)
next
  case (step e0 s0 b0 e1 s1 b1)
  have red: "P  e0,s0,b0  e1,s1,b1"
   and reds: "P  e1,s1,b1 →* e2,(h2,l2,sh2),b2"
   and IH: "h l sh. s1 = (h,l(V := None),sh)
                 P  {V:T; e1},(h,l,sh),b1 →* e2,(h2, l2(V := l V),sh2),b2"
   and s0: "s0 = (h0, l0(V := None),sh0)" by fact+
  obtain h1 l1 sh1 where s1: "s1 = (h1,l1,sh1)"
    using prod_cases3 by blast
  show ?case
  proof cases
    assume "assigned V e0"
    then obtain v e where e0: "e0 = V := Val v;; e"
      by (unfold assigned_def)blast
    from red e0 s0 have e1: "e1 = unit;;e" and s1: "s1 = (h0, l0(V  v),sh0)" and b1: "b1 = b0"
      by auto
    from e1 fin have "e1  e2" by (auto simp:final_def)
    then obtain e' s' b' where red1: "P  e1,s1,b1  e',s',b'"
      and reds': "P  e',s',b' →* e2,(h2,l2,sh2),b2"
      using converse_rtranclE3[OF reds] by blast
    from red1 e1 b1 have es': "e' = e" "s' = s1" "b' = b0" by auto
    show ?case using e0 s1 es' reds'
      by(auto intro!: InitBlockRedsFinal[OF _ fin] simp del:fun_upd_apply)
  next
    assume unass: "¬ assigned V e0"
    show ?thesis
    proof (cases "l1 V")
      assume None: "l1 V = None"
      hence "P  {V:T; e0},(h0,l0,sh0),b0  {V:T; e1},(h1, l1(V := l0 V),sh1),b1"
        using s0 s1 red by(simp add: BlockRedNone[OF _ _ unass])
      moreover
      have "P  {V:T; e1},(h1, l1(V := l0 V),sh1),b1 →* e2,(h2, l2(V := l0 V),sh2),b2"
        using IH[of _ "l1(V := l0 V)"] s1 None by(simp add:fun_upd_idem)
      ultimately show ?case by(rule converse_rtrancl_into_rtrancl)
    next
      fix v assume Some: "l1 V = Some v"
      hence "P  {V:T;e0},(h0,l0,sh0),b0  {V:T := Val v; e1},(h1,l1(V := l0 V),sh1),b1"
        using s0 s1 red by(simp add: BlockRedSome[OF _ _ unass])
      moreover
      have "P  {V:T := Val v; e1},(h1,l1(V:= l0 V),sh1),b1 →*
                e2,(h2,l2(V:=l0 V),sh2),b2"
        using InitBlockRedsFinal[OF _ fin,of _ _ "l1(V:=l0 V)" V]
              Some reds s1 by(simp add:fun_upd_idem)
      ultimately show ?case by(rule converse_rtrancl_into_rtrancl)
    qed
  qed
qed
(*>*)


subsubsection "try-catch"

lemma TryReds:
  "P  e,s,b →* e',s',b'  P  try e catch(C V) e2,s,b →* try e' catch(C V) e2,s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule TryRed)
done
(*>*)

lemma TryRedsVal:
  "P  e,s,b →* Val v,s',b'  P  try e catch(C V) e2,s,b →* Val v,s',b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule TryReds)
apply(rule RedTry)
done
(*>*)

lemma TryCatchRedsFinal:
  " P  e1,s0,b0 →* Throw a,(h1,l1,sh1),b1;  h1 a = Some(D,fs); P  D * C;
     P  e2, (h1, l1(V  Addr a),sh1),b1 →* e2', (h2,l2,sh2), b2; final e2' 
   P  try e1 catch(C V) e2, s0, b0 →* e2', (h2, l2(V := l1 V),sh2),b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule TryReds)
apply(rule converse_rtrancl_into_rtrancl)
 apply(rule RedTryCatch)
  apply fastforce
 apply assumption
apply(rule InitBlockRedsFinal)
 apply assumption
apply(simp)
done
(*>*)

lemma TryRedsFail:
  " P  e1,s,b →* Throw a,(h,l,sh),b'; h a = Some(D,fs); ¬ P  D * C 
   P  try e1 catch(C V) e2,s,b →* Throw a,(h,l,sh),b'"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule TryReds)
apply(fastforce intro!: RedTryFail)
done
(*>*)

subsubsection "List"

lemma ListReds1:
  "P  e,s,b →* e',s',b'  P  e#es,s,b [→]* e' # es,s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule ListRed1)
done
(*>*)

lemma ListReds2:
  "P  es,s,b [→]* es',s',b'  P  Val v # es,s,b [→]* Val v # es',s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule ListRed2)
done
(*>*)

lemma ListRedsVal:
  " P  e,s0,b0 →* Val v,s1,b1; P  es,s1,b1 [→]* es',s2,b2 
   P  e#es,s0,b0 [→]* Val v # es',s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule ListReds1)
apply(erule ListReds2)
done
(*>*)

subsubsection"Call"

text‹ First a few lemmas on what happens to free variables during redction. ›

lemma assumes wf: "wwf_J_prog P"
shows Red_fv: "P  e,(h,l,sh),b  e',(h',l',sh'),b'  fv e'  fv e"
  and  "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  fvs es'  fvs es"
(*<*)
proof (induct rule:red_reds_inducts)
  case (RedCall h a C fs M Ts T pns body D vs l sh b)
  hence "fv body  {this}  set pns"
    using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)
  with RedCall.hyps show ?case by fastforce
next
  case (RedSCall C M Ts T pns body D vs)
  hence "fv body  set pns"
    using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)
  with RedSCall.hyps show ?case by fastforce
qed auto
(*>*)


lemma Red_dom_lcl:
  "P  e,(h,l,sh),b  e',(h',l',sh'),b'  dom l'  dom l  fv e" and
  "P  es,(h,l,sh),b [→] es',(h',l',sh'),b'  dom l'  dom l  fvs es"
(*<*)
proof (induct rule:red_reds_inducts)
  case RedLAss thus ?case by(force split:if_splits)
next
  case CallParams thus ?case by(force split:if_splits)
next
  case BlockRedNone thus ?case by clarsimp (fastforce split:if_splits)
next
  case BlockRedSome thus ?case by clarsimp (fastforce split:if_splits)
next
  case InitBlockRed thus ?case by clarsimp (fastforce split:if_splits)
qed auto
(*>*)

lemma Reds_dom_lcl:
  " wwf_J_prog P; P  e,(h,l,sh),b →* e',(h',l',sh'),b'   dom l'  dom l  fv e"
(*<*)
apply(erule converse_rtrancl_induct_red)
 apply blast
apply(blast dest: Red_fv Red_dom_lcl)
done
(*>*)

text‹ Now a few lemmas on the behaviour of blocks during reduction. ›

lemma override_on_upd_lemma:
  "(override_on f (g(ab)) A)(a := g a) = override_on f g (insert a A)"
(*<*)
apply(rule ext)
apply(simp add:override_on_def)
done

declare fun_upd_apply[simp del] map_upds_twist[simp del]
(*>*)


lemma blocksReds:
  "l.  length Vs = length Ts; length vs = length Ts; distinct Vs;
         P  e, (h,l(Vs [↦] vs),sh),b →* e', (h',l',sh'),b' 
         P  blocks(Vs,Ts,vs,e), (h,l,sh),b →* blocks(Vs,Ts,map (the  l') Vs,e'), (h',override_on l' l (set Vs),sh'),b'"
(*<*)
proof(induct Vs Ts vs e rule:blocks_induct)
  case (1 V Vs T Ts v vs e) show ?case
    using InitBlockReds[OF "1.hyps"[of "l(Vv)"]] "1.prems"
    by(auto simp:override_on_upd_lemma)
qed auto
(*>*)


lemma blocksFinal:
 "l.  length Vs = length Ts; length vs = length Ts; final e  
       P  blocks(Vs,Ts,vs,e), (h,l,sh),b →* e, (h,l,sh),b"
(*<*)
proof(induct Vs Ts vs e rule:blocks_induct)
  case 1
  show ?case using "1.prems" InitBlockReds[OF "1.hyps"]
    by(fastforce elim!:finalE elim: rtrancl_into_rtrancl[OF _ RedInitBlock]
                                   rtrancl_into_rtrancl[OF _ InitBlockThrow])
qed auto
(*>*)


lemma blocksRedsFinal:
assumes wf: "length Vs = length Ts" "length vs = length Ts" "distinct Vs"
    and reds: "P  e, (h,l(Vs [↦] vs),sh),b →* e', (h',l',sh'),b'"
    and fin: "final e'" and l'': "l'' = override_on l' l (set Vs)"
shows "P  blocks(Vs,Ts,vs,e), (h,l,sh),b →* e', (h',l'',sh'),b'"
(*<*)
proof -
  let ?bv = "blocks(Vs,Ts,map (the o l') Vs,e')"
  have "P  blocks(Vs,Ts,vs,e), (h,l,sh),b →* ?bv, (h',l'',sh'),b'"
    using l'' by simp (rule blocksReds[OF wf reds])
  also have "P  ?bv, (h',l'',sh'),b' →* e', (h',l'',sh'),b'"
    using wf by(fastforce intro:blocksFinal fin)
  finally show ?thesis .
qed
(*>*)

text‹ An now the actual method call reduction lemmas. ›

lemma CallRedsObj:
 "P  e,s,b →* e',s',b'  P  eM(es),s,b →* e'M(es),s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CallObj)
done
(*>*)


lemma CallRedsParams:
 "P  es,s,b [→]* es',s',b'  P  (Val v)M(es),s,b →* (Val v)M(es'),s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CallParams)
done
(*>*)


lemma CallRedsFinal:
assumes wwf: "wwf_J_prog P"
and "P  e,s0,b0 →* addr a,s1,b1"
      "P  es,s1,b1 [→]* map Val vs,(h2,l2,sh2),b2"
      "h2 a = Some(C,fs)" "P  C sees M,NonStatic:TsT = (pns,body) in D"
      "size vs = size pns"
and l2': "l2' = [this  Addr a, pns[↦]vs]"
and body: "P  body,(h2,l2',sh2),b2 →* ef,(h3,l3,sh3),b3"
and "final ef"
shows "P  eM(es), s0,b0 →* ef,(h3,l2,sh3),b3"
(*<*)
proof -
  have wf: "size Ts = size pns  distinct pns  this  set pns"
    and wt: "fv body  {this}  set pns"
    using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  from body[THEN Red_lcl_add, of l2]
  have body': "P  body,(h2,l2(this Addr a, pns[↦]vs),sh2),b2 →* ef,(h3,l2++l3,sh3),b3"
    by (simp add:l2')
  have "dom l3  {this}  set pns"
    using Reds_dom_lcl[OF wwf body] wt l2' set_take_subset by force
  hence eql2: "override_on (l2++l3) l2 ({this}  set pns) = l2"
    by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
  have "P  eM(es),s0,b0 →* (addr a)M(es),s1,b1" by(rule CallRedsObj)(rule assms(2))
  also have "P  (addr a)M(es),s1,b1 →*
                 (addr a)M(map Val vs),(h2,l2,sh2),b2"
    by(rule CallRedsParams)(rule assms(3))
  also have "P  (addr a)M(map Val vs), (h2,l2,sh2),b2 
                 blocks(this#pns, Class D#Ts, Addr a#vs, body), (h2,l2,sh2),b2"
    by(rule RedCall)(auto simp: assms wf, rule assms(5))
  also (rtrancl_into_rtrancl) have "P  blocks(this#pns, Class D#Ts, Addr a#vs, body), (h2,l2,sh2),b2
                 →* ef,(h3,override_on (l2++l3) l2 ({this}  set pns),sh3),b3"
    by(rule blocksRedsFinal, insert assms wf body', simp_all)
  finally show ?thesis using eql2 by simp
qed
(*>*)


lemma CallRedsThrowParams:
  " P  e,s0,b0 →* Val v,s1,b1;  P  es,s1,b1 [→]* map Val vs1 @ throw a # es2,s2,b2 
   P  eM(es),s0,b0 →* throw a,s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsParams)
apply(rule CallThrowParams)
apply simp
done
(*>*)


lemma CallRedsThrowObj:
  "P  e,s0,b0 →* throw a,s1,b1  P  eM(es),s0,b0 →* throw a,s1,b1"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsObj)
apply(rule CallThrowObj)
done
(*>*)


lemma CallRedsNull:
  " P  e,s0,b0 →* null,s1,b1; P  es,s1,b1 [→]* map Val vs,s2,b2 
   P  eM(es),s0,b0 →* THROW NullPointer,s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsParams)
apply(rule RedCallNull)
done
(*>*)

lemma CallRedsNone:
  " P  e,s,b →* addr a,s1,b1;  P  es,s1,b1 [→]* map Val vs,s2,b2;
     hp s2 a = Some(C,fs);
    ¬(b Ts T m D. P  C sees M,b:TsT = m in D) 
   P  eM(es),s,b →* THROW NoSuchMethodError,s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsParams)
apply(cases s2,simp)
apply(erule RedCallNone, simp)
done
(*>*)

lemma CallRedsStatic:
  " P  e,s,b →* addr a,s1,b1;  P  es,s1,b1 [→]* map Val vs,s2,b2;
     hp s2 a = Some(C,fs);
     P  C sees M,Static:TsT = m in D 
   P  eM(es),s,b →* THROW IncompatibleClassChangeError,s2,b2"
(*<*)
apply(rule rtrancl_trans)
 apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsParams)
apply(cases s2,simp)
apply(erule RedCallStatic, simp)
done
(*>*)

subsection‹SCall›

lemma SCallRedsParams:
 "P  es,s,b [→]* es',s',b'  P  CsM(es),s,b →* CsM(es'),s',b'"
(*<*)
apply(erule rtrancl_induct3)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule SCallParams)
done
(*>*)

lemma SCallRedsFinal:
assumes wwf: "wwf_J_prog P"
and "P  es,s0,b0 [→]* map Val vs,(h2,l2,sh2),b2"
      "P  C sees M,Static:TsT = (pns,body) in D"
      "sh2 D = Some(sfs,Done)  (M = clinit  sh2 D = (sfs, Processing))"
      "size vs = size pns"
and l2': "l2' = [pns[↦]vs]"
and body: "P  body,(h2,l2',sh2),False →* ef,(h3,l3,sh3),b3"
and "final ef"
shows "P  CsM(es), s0,b0 →* ef,(h3,l2,sh3),b3"
(*<*)
proof -
  have wf: "size Ts = size pns  distinct pns"
    and wt: "fv body  set pns"
    using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  from body[THEN Red_lcl_add, of l2]
  have body': "P  body,(h2,l2(pns[↦]vs),sh2),False →* ef,(h3,l2++l3,sh3),b3"
    by (simp add:l2')
  have "dom l3  set pns"
    using Reds_dom_lcl[OF wwf body] wt l2' set_take_subset by force
  hence eql2: "override_on (l2++l3) l2 (set pns) = l2"
    by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
  have b2T: "P  CsM(map Val vs), (h2,l2,sh2),b2 →* CsM(map Val vs), (h2,l2,sh2),True"
  proof(cases b2)
    case True then show ?thesis by simp
  next
    case False then show ?thesis using assms(3,4) by(auto elim: SCallInitDoneRed)
  qed
  have "P  CsM(es),s0,b0 →* CsM(map Val vs),(h2,l2,sh2),b2"
    by(rule SCallRedsParams)(rule assms(2))
  also have "P  CsM(map Val vs), (h2,l2,sh2),b2 →* blocks(pns, Ts, vs, body), (h2,l2,sh2),False"
    by(auto intro!: rtrancl_into_rtrancl[OF b2T] RedSCall assms(3) simp: assms wf)
  also (rtrancl_trans) have "P  blocks(pns, Ts, vs, body), (h2,l2,sh2),False
                 →* ef,(h3,override_on (l2++l3) l2 (set pns),sh3),b3"
    by(rule blocksRedsFinal, insert assms wf body', simp_all)
  finally show ?thesis using eql2 by simp
qed
(*>*)

lemma SCallRedsThrowParams:
  " P  es,s0,b0 [→]* map Val vs1 @ throw a # es2,s2,b2 
   P  CsM(es),s0,b0 →* throw a,s2,b2"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule SCallRedsParams)
apply(rule SCallThrowParams)
apply simp
done
(*>*)

lemma SCallRedsNone:
  " P  es,s,b [→]* map Val vs,s2,False;
    ¬(b Ts T m D. P  C sees M,b:TsT = m in D) 
   P  CsM(es),s,b →* THROW NoSuchMethodError,s2,False"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule SCallRedsParams)
apply(cases s2,simp)
apply(rule RedSCallNone, simp)
done
(*>*)

lemma SCallRedsNonStatic:
  " P  es,s,b [→]* map Val vs,s2,False;
     P  C sees M,NonStatic:TsT = m in D 
   P  CsM(es),s,b →* THROW IncompatibleClassChangeError,s2,False"
(*<*)
apply(rule rtrancl_into_rtrancl)
 apply(erule SCallRedsParams)
apply(cases s2,simp)
apply(rule RedSCallNonStatic, simp)
done
(*>*)

lemma SCallInitThrowReds:
assumes wwf: "wwf_J_prog P"
and "P  es,s0,b0 [→]* map Val vs,(h1,l1,sh1),False"
      "P  C sees M,Static:TsT = (pns,body) in D"
      "sfs. sh1 D = Some(sfs,Done)"
      "M  clinit"
and "P  INIT D ([D],False)  unit,(h1,l1,sh1),False →* throw a,(h2,l2,sh2),b2"
shows "P  CsM(es), s0,b0 →* throw a,(h2,l2,sh2),b2"
(*<*)
proof -
  have "P  CsM(es),s0,b0 →* CsM(map Val vs),(h1,l1,sh1),False"
    by(rule SCallRedsParams)(rule assms(2))
  also have "P  CsM(map Val vs),(h1,l1,sh1),False  INIT D ([D],False)  CsM(map Val vs),(h1,l1,sh1),False"
    using SCallInitRed[OF assms(3)] assms(4-5) by auto
  also (rtrancl_into_rtrancl) have "P  INIT D ([D],False)  CsM(map Val vs),(h1,l1,sh1),False
                 →* throw a,(h2,l2,sh2),b2"
    by(rule InitSeqThrowReds[OF assms(6)])
  finally show ?thesis by simp
qed
(*>*)

lemma SCallInitReds:
assumes wwf: "wwf_J_prog P"
and "P  es,s0,b0 [→]* map Val vs,(h1,l1,sh1),False"
      "P  C sees M,Static:TsT = (pns,body) in D"
      "sfs. sh1 D = Some(sfs,Done)"
      "M  clinit"
and "P  INIT D ([D],False)  unit,(h1,l1,sh1),False →* Val v',(h2,l2,sh2),b2"
and "size vs = size pns"
and l2': "l2' = [pns[↦]vs]"
and body: "P  body,(h2,l2',sh2),False →* ef,(h3,l3,sh3),b3"
and "final ef"
shows "P  CsM(es),s0,b0 →* ef,(h3,l2,sh3),b3"
(*<*)
proof -
  have wf: "size Ts = size pns  distinct pns"
    and wt: "fv body  set pns"
    using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  from body[THEN Red_lcl_add, of l2]
  have body': "P  body,(h2,l2(pns[↦]vs),sh2),False →* ef,(h3,l2++l3,sh3),b3"
    by (simp add:l2')
  have "dom l3  set pns"
    using Reds_dom_lcl[OF wwf body] wt l2' set_take_subset by force
  hence eql2: "override_on (l2++l3) l2 (set pns) = l2"
    by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
  have "icheck P D (CsM(map Val vs)::'a exp)" using assms(3) by auto
  then have "P  CsM(map Val vs),(h2, l2, sh2),icheck P D (CsM(map Val vs))
        blocks(pns, Ts, vs, body), (h2, l2, sh2), False"
    by (metis (full_types) assms(3) assms(7) local.wf red_reds.RedSCall)
  also have "P  blocks(pns, Ts, vs, body), (h2, l2, sh2), False
         →* ef,(h3,override_on (l2++l3) l2 (set pns),sh3),b3"
    by(rule blocksRedsFinal, insert assms wf body', simp_all)
  finally have trueReds: "P  CsM(map Val vs),(h2, l2, sh2),icheck P D (CsM(map Val vs))
                   →* ef,(h3,override_on (l2++l3) l2 (set pns),sh3),b3" by simp
  have "P  CsM(es),s0,b0 →* CsM(map Val vs),(h1,l1,sh1),False"
    by(rule SCallRedsParams)(rule assms(2))
  also have "P  CsM(map Val vs),(h1,l1,sh1),False  INIT D ([D],False)  CsM(map Val vs),(h1,l1,sh1),False"
    using SCallInitRed[OF assms(3)] assms(4-5) by auto
  also (rtrancl_into_rtrancl) have "P  INIT D ([D],False)  CsM(map Val vs),(h1,l1,sh1),False
                 →* ef,(h3,override_on (l2++l3) l2 (set pns),sh3),b3"
    using InitSeqReds[OF assms(6) trueReds] assms(5) by simp
  finally show ?thesis using eql2 by simp
qed
(*>*)

lemma SCallInitProcessingReds:
assumes wwf: "wwf_J_prog P"
and "P  es,s0,b0 [→]* map Val vs,(h2,l2,sh2),b2"
      "P  C sees M,Static:TsT = (pns,body) in D"
      "sh2 D = Some(sfs,Processing)"
and "size vs = size pns"
and l2': "l2' = [pns[↦]vs]"
and body: "P  body,(h2,l2',sh2),False →* ef,(h3,l3,sh3),b3"
and "final ef"
shows "P  CsM(es),s0,b0 →* ef,(h3,l2,sh3),b3"
(*<*)
proof -
  have wf: "size Ts = size pns  distinct pns"
    and wt: "fv body  set pns"
    using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  from body[THEN Red_lcl_add, of l2]
  have body': "P  body,(h2,l2(pns[↦]vs),sh2),False →* ef,(h3,l2++l3,sh3),b3"
    by (simp add:l2')
  have "dom l3  set pns"
    using Reds_dom_lcl[OF wwf body] wt l2' set_take_subset by force
  hence eql2: "override_on (l2++l3) l2 (set pns) = l2"
    by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
  have b2T: "P  CsM(map Val vs), (h2,l2,sh2),b2 →* CsM(map Val vs), (h2,l2,sh2),True"
  proof(cases b2)
    case True then show ?thesis by simp
  next
    case False
    show ?thesis
    proof(cases "M = clinit")
      case True then show ?thesis using False assms(3) red_reds.SCallInitDoneRed assms(4)
        by (simp add: r_into_rtrancl)
    next
      case nclinit: False
      have icheck: "icheck P D (CsM(map Val vs))" using assms(3) by auto
      have "P  CsM(map Val vs),(h2, l2, sh2),b2
          INIT D ([D],False)  CsM(map Val vs),(h2, l2, sh2),False"
        using SCallInitRed[OF assms(3)] assms(4) False nclinit by simp
      also have "P  INIT D ([D],False)  CsM(map Val vs),(h2, l2, sh2),False
          INIT D (Nil,True)  CsM(map Val vs),(h2, l2, sh2),False"
        using RedInitProcessing assms(4) by simp
      also have "P  INIT D (Nil,True)  CsM(map Val vs),(h2, l2, sh2),False
          CsM(map Val vs),(h2, l2, sh2),True"
        using RedInit[of "CsM(map Val vs)" D _ _ _ P] icheck nclinit
         by (metis (full_types) nsub_RI_Vals sub_RI.simps(12))
      finally show ?thesis by simp
    qed
  qed
  have "P  CsM(es),s0,b0 →* CsM(map Val vs),(h2,l2,sh2),b2"
    by(rule SCallRedsParams)(rule assms(2))
  also have "P  CsM(map Val vs), (h2,l2,sh2),b2 →* blocks(pns, Ts, vs, body), (h2,l2,sh2),False"
    by(auto intro!: rtrancl_into_rtrancl[OF b2T] RedSCall assms(3) simp: assms wf)
  also (rtrancl_trans) have "P  blocks(pns, Ts, vs, body), (h2,l2,sh2),False
                 →* ef,(h3,override_on (l2++l3) l2 (set pns),sh3),b3"
    by(rule blocksRedsFinal, insert assms wf body', simp_all)
  finally show ?thesis using eql2 by simp
qed
(*>*)

(***********************************)

subsubsection "The main Theorem"

lemma assumes wwf: "wwf_J_prog P"
shows big_by_small: "P  e,s  e',s'
    (b. iconf (shp s) e  P,shp s b (e,b)   P  e,s,b →* e',s',False)"
and bigs_by_smalls: "P  es,s [⇒] es',s'
    (b. iconfs (shp s) es  P,shp s b (es,b)   P  es,s,b [→]* es',s',False)"
(*<*)
proof (induct rule: eval_evals.inducts)
  case New show ?case
  proof(cases b)
    case True then show ?thesis using RedNew[OF New.hyps(2-4)] by auto
  next
    case False then show ?thesis using New.hyps(1) NewInitDoneReds[OF _ New.hyps(2-4)] by auto
  qed
next
  case NewFail show ?case
  proof(cases b)
    case True then show ?thesis using RedNewFail[OF NewFail.hyps(2)] NewFail.hyps(3) by fastforce
  next
    case False
    then show ?thesis using NewInitDoneReds2[OF _ NewFail.hyps(2)] NewFail by fastforce
  qed
next
  case (NewInit sh C h l v' h' l' sh' a FDTs h'') show ?case
  proof(cases b)
    case True
    then obtain sfs where shC: "sh C = (sfs, Processing)"
      using NewInit.hyps(1) NewInit.prems by(clarsimp simp: bconf_def initPD_def)
    then have s': "(h',l',sh') = (h,l,sh)" using NewInit.hyps(2) init_ProcessingE by clarsimp
    then show ?thesis using RedNew[OF NewInit.hyps(4-6)] True by auto
  next
    case False
    then have init: "P  INIT C ([C],False)  unit,(h, l, sh),False →* Val v',(h', l', sh'),False"
      using NewInit.hyps(3) by(auto simp: bconf_def)
    then show ?thesis using NewInit NewInitReds[OF _ init NewInit.hyps(4-6)] False
     has_fields_is_class[OF NewInit.hyps(5)] by auto
  qed
next
  case (NewInitOOM sh C h l v' h' l' sh') show ?case
  proof(cases b)
    case True
    then obtain sfs where shC: "sh C = (sfs, Processing)"
      using NewInitOOM.hyps(1) NewInitOOM.prems by(clarsimp simp: bconf_def initPD_def)
    then have s': "(h',l',sh') = (h,l,sh)" using NewInitOOM.hyps(2) init_ProcessingE by clarsimp
    then show ?thesis using RedNewFail[OF NewInitOOM.hyps(4)] True r_into_rtrancl NewInitOOM.hyps(5)
      by auto
  next
    case False
    then have init: "P  INIT C ([C],False)  unit,(h, l, sh),False →* Val v',(h', l', sh'),False"
      using NewInitOOM.hyps(3) by(auto simp: bconf_def)
    then show ?thesis using NewInitOOM.hyps(1) NewInitOOMReds[OF _ init NewInitOOM.hyps(4)] False
      NewInitOOM.hyps(5) by auto
  qed
next
  case (NewInitThrow sh C h l a s') show ?case
  proof(cases b)
    case True
    then obtain sfs where shC: "sh C = (sfs, Processing)"
      using NewInitThrow.hyps(1) NewInitThrow.prems by(clarsimp simp: bconf_def initPD_def)
    then show ?thesis using NewInitThrow.hyps(2) init_ProcessingE by blast
  next
    case False
    then have init: "P  INIT C ([C],False)  unit,(h, l, sh),b →* throw a,s',False"
      using NewInitThrow.hyps(3) by(auto simp: bconf_def)
    then show ?thesis using NewInitThrow NewInitThrowReds[of "(h,l,sh)" C P a s'] False by auto
  qed
next
  case Cast then show ?case by(fastforce intro:CastRedsAddr)
next
  case CastNull then show ?case by(fastforce intro: CastRedsNull)
next
  case CastFail thus ?case by(fastforce intro!:CastRedsFail)
next
  case CastThrow thus ?case by(fastforce dest!:eval_final intro:CastRedsThrow)
next
  case Val then show ?case using exI[of _ b] by(simp add: bconf_def)
next
  case (BinOp e1 s0 v1 s1 e2 v2 s2 bop v)
  show ?case
  proof(cases "val_of e1")
    case None
    then have iconf: "iconf (shp s0) e1" using None BinOp.prems by auto
    have bconf: "P,shp s0 b (e1,b) " using None BinOp.prems by auto
    then have b1: "P  e1,s0,b →* Val v1,s1,False" using iconf BinOp.hyps(2) by auto
    have binop: "P  e1 «bop» e2,s0,b →* Val v1 «bop» e2,s1,False" by(rule BinOp1Reds[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf binop] None BinOp by auto
    have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
    then have b2: "P  e2,s1,False →* Val v2,s2,False" using BinOp.hyps(4)[OF iconf2'] by auto
    then show ?thesis using BinOpRedsVal[OF b1 b2 BinOp.hyps(5)] by fast
  next
    case (Some a)
    then obtain b1 where b1: "P  e1,s0,b →* Val v1,s1,b1"
      by (metis (no_types, lifting) BinOp.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have binop: "P  e1 «bop» e2,s0,b →* Val v1 «bop» e2,s1,b1" by(rule BinOp1Reds[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf binop] BinOp by auto
    have bconf2: "P,shp s0 b (e2,b) " using BinOp.prems Some by simp
    then have "P,shp s1 b (e2,b1) " using Red_preserves_bconf[OF wwf binop BinOp.prems] by simp
    then have b2: "P  e2,s1,b1 →* Val v2,s2,False" using BinOp.hyps(4)[OF iconf2'] by auto
    then show ?thesis using BinOpRedsVal[OF b1 b2 BinOp.hyps(5)] by fast
  qed
next
  case (BinOpThrow1 e1 s0 e s1 bop e2) show ?case
  proof(cases "val_of e1")
    case None
    then have "iconf (shp s0) e1" and "P,shp s0 b (e1,b) " using BinOpThrow1.prems by auto
    then have b1: "P  e1,s0,b →* throw e,s1,False" using BinOpThrow1.hyps(2) by auto
    then have "P  e1 «bop» e2,s0,b →* throw e,s1,False"
      using BinOpThrow1 None by(auto dest!:eval_final simp: BinOpRedsThrow1[OF b1])
    then show ?thesis by fast
  next
    case (Some a)
    then show ?thesis using eval_final_same[OF BinOpThrow1.hyps(1)] val_of_spec[OF Some] by auto
  qed
next
  case (BinOpThrow2 e1 s0 v1 s1 e2 e s2 bop)
  show ?case
  proof(cases "val_of e1")
    case None
    then have iconf: "iconf (shp s0) e1" using None BinOpThrow2.prems by auto
    have bconf: "P,shp s0 b (e1,b) " using None BinOpThrow2.prems by auto
    then have b1: "P  e1,s0,b →* Val v1,s1,False" using iconf BinOpThrow2.hyps(2) by auto
    have binop: "P  e1 «bop» e2,s0,b →* Val v1 «bop» e2,s1,False" by(rule BinOp1Reds[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf binop] None BinOpThrow2 by auto
    have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
    then have b2: "P  e2,s1,False →* throw e,s2,False" using BinOpThrow2.hyps(4)[OF iconf2'] by auto
    then show ?thesis using BinOpRedsThrow2[OF b1 b2] by fast
  next
    case (Some a)
    then obtain b1 where b1: "P  e1,s0,b →* Val v1,s1,b1"
      by (metis (no_types, lifting) BinOpThrow2.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have binop: "P  e1 «bop» e2,s0,b →* Val v1 «bop» e2,s1,b1" by(rule BinOp1Reds[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf binop] BinOpThrow2 by auto
    have bconf2: "P,shp s0 b (e2,b) " using BinOpThrow2.prems Some by simp
    then have "P,shp s1 b (e2,b1) " using Red_preserves_bconf[OF wwf binop BinOpThrow2.prems] by simp
    then have b2: "P  e2,s1,b1 →* throw e,s2,False" using BinOpThrow2.hyps(4)[OF iconf2'] by auto
    then show ?thesis using BinOpRedsThrow2[OF b1 b2] by fast
  qed
next
  case Var thus ?case by(auto dest:RedVar simp: bconf_def)
next
  case LAss thus ?case by(auto dest: LAssRedsVal)
next
  case LAssThrow thus ?case by(auto dest!:eval_final dest: LAssRedsThrow)
next
  case FAcc thus ?case by(fastforce intro:FAccRedsVal)
next
  case FAccNull thus ?case by(auto dest:FAccRedsNull)
next
  case FAccThrow thus ?case by(auto dest!:eval_final dest:FAccRedsThrow)
next
  case FAccNone then show ?case by(fastforce intro: FAccRedsNone)
next
  case FAccStatic then show ?case by(fastforce intro: FAccRedsStatic)
next
  case SFAcc show ?case
  proof(cases b)
    case True then show ?thesis using RedSFAcc SFAcc.hyps by auto
  next
    case False then show ?thesis using SFAcc.hyps SFAccInitDoneReds[OF SFAcc.hyps(1)] by auto
  qed
next
  case (SFAccInit C F t D sh h l v' h' l' sh' sfs i v) show ?case
  proof(cases b)
    case True
    then obtain sfs where shC: "sh D = (sfs, Processing)"
      using SFAccInit.hyps(2) SFAccInit.prems by(clarsimp simp: bconf_def initPD_def)
    then have s': "(h',l',sh') = (h,l,sh)" using SFAccInit.hyps(3) init_ProcessingE by clarsimp
    then show ?thesis using RedSFAcc SFAccInit.hyps True by auto
  next
    case False
    then have init: "P  INIT D ([D],False)  unit,(h, l, sh),False →* Val v',(h', l', sh'),False"
      using SFAccInit.hyps(4) by(auto simp: bconf_def)
    then show ?thesis using SFAccInit SFAccInitReds[OF _ _ init] False by auto
  qed
next
  case (SFAccInitThrow C F t D sh h l a s') show ?case
  proof(cases b)
    case True
    then obtain sfs where shC: "sh D = (sfs, Processing)"
      using SFAccInitThrow.hyps(2) SFAccInitThrow.prems(2) by(clarsimp simp: bconf_def initPD_def)
    then show ?thesis using SFAccInitThrow.hyps(3) init_ProcessingE by blast
  next
    case False
    then have init: "P  INIT D ([D],False)  unit,(h, l, sh),b →* throw a,s',False"
      using SFAccInitThrow.hyps(4) by(auto simp: bconf_def)
    then show ?thesis using SFAccInitThrow SFAccInitThrowReds False by auto
  qed
next
  case SFAccNone then show ?case by(fastforce intro: SFAccRedsNone)
next
  case SFAccNonStatic then show ?case by(fastforce intro: SFAccRedsNonStatic)
next
  case (FAss e1 s0 a s1 e2 v h2 l2 sh2 C fs F t D fs' h2')
  show ?case
  proof(cases "val_of e1")
    case None
    then have iconf: "iconf (shp s0) e1" using None FAss.prems by auto
    have bconf: "P,shp s0 b (e1,b) " using None FAss.prems by auto
    then have b1: "P  e1,s0,b →* addr a,s1,False" using iconf FAss.hyps(2) by auto
    have fass: "P  e1F{D} := e2,s0,b →* addr aF{D} := e2,s1,False" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] None FAss by auto
    have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
    then have b2: "P  e2,s1,False →* Val v,(h2, l2, sh2),False" using FAss.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsVal[OF b1 b2 FAss.hyps(6) FAss.hyps(5)[THEN sym]] FAss.hyps(7,8) by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e1,s0,b →* addr a,s1,b1"
      by (metis (no_types, lifting) FAss.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  e1F{D} := e2,s0,b →* addr aF{D} := e2,s1,b1" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] FAss by auto
    have bconf2: "P,shp s0 b (e2,b) " using FAss.prems Some by simp
    then have "P,shp s1 b (e2,b1) " using Red_preserves_bconf[OF wwf fass FAss.prems] by simp
    then have b2: "P  e2,s1,b1 →* Val v,(h2, l2, sh2),False" using FAss.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsVal[OF b1 b2] FAss.hyps(5)[THEN sym] FAss.hyps(6-8) by fast
  qed
next
  case (FAssNull e1 s0 s1 e2 v s2 F D)
  show ?case
  proof(cases "val_of e1")
    case None
    then have iconf: "iconf (shp s0) e1" using FAssNull.prems(1) by simp
    have bconf: "P,shp s0 b (e1,b) " using FAssNull.prems(2) None by simp
    then have b1: "P  e1,s0,b →* null,s1,False" using FAssNull.hyps(2)[OF iconf] by auto
    have fass: "P  e1F{D} := e2,s0,b →* nullF{D} := e2,s1,False" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] None FAssNull by auto
    have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
    then have b2: "P  e2,s1,False →* Val v,s2,False" using FAssNull.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsNull[OF b1 b2] by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e1,s0,b →* null,s1,b1"
      by (metis (no_types, lifting) FAssNull.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  e1F{D} := e2,s0,b →* nullF{D} := e2,s1,b1" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] FAssNull by auto
    have bconf2: "P,shp s0 b (e2,b) " using FAssNull.prems Some by simp
    then have "P,shp s1 b (e2,b1) " using Red_preserves_bconf[OF wwf fass FAssNull.prems] by simp
    then have b2: "P  e2,s1,b1 →* Val v,s2,False" using FAssNull.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsNull[OF b1 b2] by fast
  qed
next
  case (FAssThrow1 e1 s0 e' s1 F D e2) show ?case
  proof(cases "val_of e1")
    case None
    then have "iconf (shp s0) e1" and "P,shp s0 b (e1,b) " using FAssThrow1.prems by auto
    then have b1: "P  e1,s0,b →* throw e',s1,False" using FAssThrow1.hyps(2) by auto
    then have "P  e1F{D} := e2,s0,b →* throw e',s1,False"
      using FAssThrow1 None by(auto dest!:eval_final simp: FAssRedsThrow1[OF b1])
    then show ?thesis by fast
  next
    case (Some a)
    then show ?thesis using eval_final_same[OF FAssThrow1.hyps(1)] val_of_spec[OF Some] by auto
  qed
next
  case (FAssThrow2 e1 s0 v s1 e2 e' s2 F D)
  show ?case
  proof(cases "val_of e1")
    case None
    then have iconf: "iconf (shp s0) e1" using None FAssThrow2.prems by auto
    have bconf: "P,shp s0 b (e1,b) " using None FAssThrow2.prems by auto
    then have b1: "P  e1,s0,b →* Val v,s1,False" using iconf FAssThrow2.hyps(2) by auto
    have fass: "P  e1F{D} := e2,s0,b →* Val vF{D} := e2,s1,False" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] None FAssThrow2 by auto
    have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
    then have b2: "P  e2,s1,False →* throw e',s2,False" using FAssThrow2.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsThrow2[OF b1 b2] by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e1,s0,b →* Val v,s1,b1"
      by (metis (no_types, lifting) FAssThrow2.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  e1F{D} := e2,s0,b →* Val vF{D} := e2,s1,b1" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] FAssThrow2 by auto
    have bconf2: "P,shp s0 b (e2,b) " using FAssThrow2.prems Some by simp
    then have "P,shp s1 b (e2,b1) " using Red_preserves_bconf[OF wwf fass FAssThrow2.prems] by simp
    then have b2: "P  e2,s1,b1 →* throw e',s2,False" using FAssThrow2.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsThrow2[OF b1 b2] by fast
  qed
next
  case (FAssNone e1 s0 a s1 e2 v h2 l2 sh2 C fs F D)
  show ?case
  proof(cases "val_of e1")
    case None
    then have iconf: "iconf (shp s0) e1" using None FAssNone.prems by auto
    have bconf: "P,shp s0 b (e1,b) " using None FAssNone.prems by auto
    then have b1: "P  e1,s0,b →* addr a,s1,False" using iconf FAssNone.hyps(2) by auto
    have fass: "P  e1F{D} := e2,s0,b →* addr aF{D} := e2,s1,False" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] None FAssNone by auto
    have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
    then have b2: "P  e2,s1,False →* Val v,(h2, l2, sh2),False" using FAssNone.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsNone[OF b1 b2 FAssNone.hyps(5,6)] by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e1,s0,b →* addr a,s1,b1"
      by (metis (no_types, lifting) FAssNone.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  e1F{D} := e2,s0,b →* addr aF{D} := e2,s1,b1" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] FAssNone by auto
    have bconf2: "P,shp s0 b (e2,b) " using FAssNone.prems Some by simp
    then have "P,shp s1 b (e2,b1) " using Red_preserves_bconf[OF wwf fass FAssNone.prems] by simp
    then have b2: "P  e2,s1,b1 →* Val v,(h2, l2, sh2),False" using FAssNone.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsNone[OF b1 b2 FAssNone.hyps(5,6)] by fast
  qed
next
  case (FAssStatic e1 s0 a s1 e2 v h2 l2 sh2 C fs F t D)
  show ?case
  proof(cases "val_of e1")
    case None
    then have iconf: "iconf (shp s0) e1" using None FAssStatic.prems by auto
    have bconf: "P,shp s0 b (e1,b) " using None FAssStatic.prems by auto
    then have b1: "P  e1,s0,b →* addr a,s1,False" using iconf FAssStatic.hyps(2) by auto
    have fass: "P  e1F{D} := e2,s0,b →* addr aF{D} := e2,s1,False" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] None FAssStatic by auto
    have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
    then have b2: "P  e2,s1,False →* Val v,(h2, l2, sh2),False" using FAssStatic.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsStatic[OF b1 b2 FAssStatic.hyps(5,6)] by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e1,s0,b →* addr a,s1,b1"
      by (metis (no_types, lifting) FAssStatic.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  e1F{D} := e2,s0,b →* addr aF{D} := e2,s1,b1" by(rule FAssReds1[OF b1])
    then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf fass] FAssStatic by auto
    have bconf2: "P,shp s0 b (e2,b) " using FAssStatic.prems Some by simp
    then have "P,shp s1 b (e2,b1) " using Red_preserves_bconf[OF wwf fass FAssStatic.prems] by simp
    then have b2: "P  e2,s1,b1 →* Val v,(h2, l2, sh2),False" using FAssStatic.hyps(4)[OF iconf2'] by auto
    then show ?thesis using FAssRedsStatic[OF b1 b2 FAssStatic.hyps(5,6)] by fast
  qed
next
  case (SFAss e2 s0 v h1 l1 sh1 C F t D sfs sfs' sh1')
  show ?case
  proof(cases "val_of e2")
    case None
    then have bconf: "P,shp s0 b (e2,b) " using SFAss.prems(2) by simp
    then have b1: "P  e2,s0,b →* Val v,(h1, l1, sh1),False" using SFAss by auto
    thus ?thesis using SFAssRedsVal[OF b1 SFAss.hyps(3,4)] SFAss.hyps(5,6) by fast
  next
    case (Some a)
    then obtain b1 where b1: "P  e2,s0,b →* Val v,(h1, l1, sh1),b1"
      by (metis (no_types, lifting) SFAss.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    thus ?thesis using SFAssRedsVal[OF b1 SFAss.hyps(3,4)] SFAss.hyps(5,6) by fast
  qed
next
  case (SFAssInit e2 s0 v h1 l1 sh1 C F t D v' h' l' sh' sfs i sfs' sh'')
  then have iconf: "iconf (shp s0) e2" by simp
  show ?case
  proof(cases "val_of e2")
    case None
    then have bconf: "P,shp s0 b (e2,b) " using SFAssInit.prems(2) by simp
    then have reds: "P  e2,s0,b →* Val v,(h1, l1, sh1),False"
      using SFAssInit.hyps(2)[OF iconf bconf] by auto
    then have init: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* Val v',(h', l', sh'),False"
      using SFAssInit.hyps(6) by(auto simp: bconf_def)
    then show ?thesis using SFAssInit SFAssInitReds[OF reds SFAssInit.hyps(3) _ init] by auto
  next
    case (Some v2) show ?thesis
    proof(cases b)
      case False
      then have bconf: "P,shp s0 b (e2,b) " by(simp add: bconf_def)
      then have reds: "P  e2,s0,b →* Val v,(h1, l1, sh1),False"
        using SFAssInit.hyps(2)[OF iconf bconf] by auto
      then have init: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* Val v',(h', l', sh'),False"
        using SFAssInit.hyps(6) by(auto simp: bconf_def)
      then show ?thesis using SFAssInit SFAssInitReds[OF reds SFAssInit.hyps(3) _ init] by auto
    next
      case True
      have e2: "e2 = Val v2" using val_of_spec[OF Some] by simp
      then have vs: "v2 = v  s0 = (h1, l1, sh1)" using eval_final_same[OF SFAssInit.hyps(1)] by simp
      then obtain sfs where shC: "sh1 D = (sfs, Processing)"
        using SFAssInit.hyps(3,4) SFAssInit.prems(2) Some True
          by(cases e2, auto simp: bconf_def initPD_def dest: sees_method_fun)
      then have s': "(h',l',sh') = (h1, l1, sh1)" using SFAssInit.hyps(5) init_ProcessingE by clarsimp
      then show ?thesis using SFAssInit.hyps(3,7-9) True e2 red_reds.RedSFAss vs by auto
    qed
  qed
next
  case (SFAssInitThrow e2 s0 v h1 l1 sh1 C F t D a s')
  then have iconf: "iconf (shp s0) e2" by simp
  show ?case
  proof(cases "val_of e2")
    case None
    then have bconf: "P,shp s0 b (e2,b) " using SFAssInitThrow.prems(2) by simp
    then have reds: "P  e2,s0,b →* Val v,(h1, l1, sh1),False"
      using SFAssInitThrow.hyps(2)[OF iconf bconf] by auto
    then have init: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* throw a,s',False"
      using SFAssInitThrow.hyps(6) by(auto simp: bconf_def)
    then show ?thesis using SFAssInitThrow SFAssInitThrowReds[OF reds _ _ init] by auto
  next
    case (Some v2) show ?thesis
    proof(cases b)
      case False
      then have bconf: "P,shp s0 b (e2,b) " by(simp add: bconf_def)
      then have reds: "P  e2,s0,b →* Val v,(h1, l1, sh1),False"
        using SFAssInitThrow.hyps(2)[OF iconf bconf] by auto
      then have init: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* throw a,s',False"
        using SFAssInitThrow.hyps(6) by(auto simp: bconf_def)
      then show ?thesis using SFAssInitThrow SFAssInitThrowReds[OF reds _ _ init] by auto
    next
      case True
      obtain v2 where e2: "e2 = Val v2" using val_of_spec[OF Some] by simp
      then have vs: "v2 = v  s0 = (h1, l1, sh1)"
        using eval_final_same[OF SFAssInitThrow.hyps(1)] by simp
      then obtain sfs where shC: "sh1 D = (sfs, Processing)"
       using SFAssInitThrow.hyps(4) SFAssInitThrow.prems(2) Some True
        by(cases e2, auto simp: bconf_def initPD_def dest: sees_method_fun)
      then show ?thesis using SFAssInitThrow.hyps(5) init_ProcessingE by blast
    qed
  qed
next
  case (SFAssThrow e2 s0 e' s2 C F D)
  show ?case
  proof(cases "val_of e2")
    case None
    then have bconf: "P,shp s0 b (e2,b) " using SFAssThrow.prems(2) None by simp
    then have b1: "P  e2,s0,b →* throw e',s2,False" using SFAssThrow by auto
    thus ?thesis using SFAssRedsThrow[OF b1] by fast
  next
    case (Some a)
    then show ?thesis using eval_final_same[OF SFAssThrow.hyps(1)] val_of_spec[OF Some] by auto
  qed
next
  case (SFAssNone e2 s0 v h2 l2 sh2 C F D)
  show ?case
  proof(cases "val_of e2")
    case None
    then have iconf: "iconf (shp s0) e2" using SFAssNone by simp
    then have bconf: "P,shp s0 b (e2,b) " using SFAssNone.prems(2) None by simp
    then have b1: "P  e2,s0,b →* Val v,(h2, l2, sh2),False" using SFAssNone.hyps(2) iconf by auto
    thus ?thesis using SFAssRedsNone[OF b1 SFAssNone.hyps(3)] by fast
  next
    case (Some a)
    then obtain b1 where b1: "P  e2,s0,b →* Val v,(h2, l2, sh2),b1"
      by (metis (no_types, lifting) SFAssNone.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    thus ?thesis using SFAssRedsNone[OF b1 SFAssNone.hyps(3)] by fast
  qed
next
  case (SFAssNonStatic e2 s0 v h2 l2 sh2 C F t D) show ?case
  proof(cases "val_of e2")
    case None
    then have iconf: "iconf (shp s0) e2" using SFAssNonStatic by simp
    then have bconf: "P,shp s0 b (e2,b) " using SFAssNonStatic.prems(2) None by simp
    then have b1: "P  e2,s0,b →* Val v,(h2, l2, sh2),False" using SFAssNonStatic.hyps(2) iconf by auto
    thus ?thesis using SFAssRedsNonStatic[OF b1 SFAssNonStatic.hyps(3)] by fast
  next
    case (Some a)
    then obtain b' where b1: "P  e2,s0,b →* Val v,(h2, l2, sh2),b'"
      by (metis (no_types, lifting) SFAssNonStatic.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    thus ?thesis using SFAssRedsNonStatic[OF b1 SFAssNonStatic.hyps(3)] by fast
  qed
next
  case (CallObjThrow e s0 e' s1 M ps) show ?case
  proof(cases "val_of e")
    case None
    then have "iconf (shp s0) e" and "P,shp s0 b (e,b) " using CallObjThrow.prems by auto
    then have b1: "P  e,s0,b →* throw e',s1,False" using CallObjThrow.hyps(2) by auto
    then have "P  eM(ps),s0,b →* throw e',s1,False"
      using CallObjThrow None by(auto dest!:eval_final simp: CallRedsThrowObj[OF b1])
    then show ?thesis by fast
  next
    case (Some a)
    then show ?thesis using eval_final_same[OF CallObjThrow.hyps(1)] val_of_spec[OF Some] by auto
  qed
next
  case (CallNull e s0 s1 ps vs s2 M) show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s0) e" using CallNull.prems(1) by simp
    have bconf: "P,shp s0 b (e,b) " using CallNull.prems(2) None by simp
    then have b1: "P  e,s0,b →* null,s1,False" using CallNull.hyps(2)[OF iconf] by auto
    have call: "P  eM(ps),s0,b →* nullM(ps),s1,False" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf call] None CallNull by auto
    have "P,shp s1 b (ps,False) " by(simp add: bconfs_def)
    then have b2: "P  ps,s1,False [→]* map Val vs,s2,False" using CallNull.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsNull[OF b1 b2] by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e,s0,b →* null,s1,b1"
      by (metis (no_types, lifting) CallNull.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  eM(ps),s0,b →* nullM(ps),s1,b1" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf fass] CallNull by auto
    have bconf2: "P,shp s0 b (ps,b) " using CallNull.prems Some by simp
    then have "P,shp s1 b (ps,b1) " using Red_preserves_bconf[OF wwf fass CallNull.prems] by simp
    then have b2: "P  ps,s1,b1 [→]* map Val vs,s2,False" using CallNull.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsNull[OF b1 b2] by fast
  qed
next
  case (CallParamsThrow e s0 v s1 es vs ex es' s2 M) show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s0) e" using CallParamsThrow.prems(1) by simp
    have bconf: "P,shp s0 b (e,b) " using CallParamsThrow.prems(2) None by simp
    then have b1: "P  e,s0,b →* Val v,s1,False" using CallParamsThrow.hyps(2)[OF iconf] by auto
    have call: "P  eM(es),s0,b →* Val vM(es),s1,False" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) es" using Red_preserves_iconf[OF wwf call] None CallParamsThrow by auto
    have "P,shp s1 b (es,False) " by(simp add: bconfs_def)
    then have b2: "P  es,s1,False [→]* map Val vs @ throw ex # es',s2,False"
      using CallParamsThrow.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsThrowParams[OF b1 b2] by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e,s0,b →* Val v,s1,b1"
      by (metis (no_types, lifting) CallParamsThrow.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  eM(es),s0,b →* Val vM(es),s1,b1" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) es" using Red_preserves_iconf[OF wwf fass] CallParamsThrow by auto
    have bconf2: "P,shp s0 b (es,b) " using CallParamsThrow.prems Some by simp
    then have "P,shp s1 b (es,b1) " using Red_preserves_bconf[OF wwf fass CallParamsThrow.prems] by simp
    then have b2: "P  es,s1,b1 [→]* map Val vs @ throw ex # es',s2,False"
      using CallParamsThrow.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsThrowParams[OF b1 b2] by fast
  qed
next
  case (CallNone e s0 a s1 ps vs h2 l2 sh2 C fs M) show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s0) e" using CallNone.prems(1) by simp
    have bconf: "P,shp s0 b (e,b) " using CallNone.prems(2) None by simp
    then have b1: "P  e,s0,b →* addr a,s1,False" using CallNone.hyps(2)[OF iconf] by auto
    have call: "P  eM(ps),s0,b →* addr aM(ps),s1,False" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf call] None CallNone by auto
    have "P,shp s1 b (ps,False) " by(simp add: bconfs_def)
    then have b2: "P  ps,s1,False [→]* map Val vs,(h2, l2, sh2),False"
      using CallNone.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsNone[OF b1 b2 _ CallNone.hyps(6)] CallNone.hyps(5) by fastforce
  next
    case (Some a')
    then obtain b1 where b1: "P  e,s0,b →* addr a,s1,b1"
      by (metis (no_types, lifting) CallNone.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fass: "P  eM(ps),s0,b →* addr aM(ps),s1,b1" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf fass] CallNone by auto
    have bconf2: "P,shp s0 b (ps,b) " using CallNone.prems Some by simp
    then have "P,shp s1 b (ps,b1) " using Red_preserves_bconf[OF wwf fass CallNone.prems] by simp
    then have b2: "P  ps,s1,b1 [→]* map Val vs,(h2, l2, sh2),False"
      using CallNone.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsNone[OF b1 b2 _ CallNone.hyps(6)] CallNone.hyps(5) by fastforce
  qed
next
  case (CallStatic e s0 a s1 ps vs h2 l2 sh2 C fs M Ts T m D) show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s0) e" using CallStatic.prems(1) by simp
    have bconf: "P,shp s0 b (e,b) " using CallStatic.prems(2) None by simp
    then have b1: "P  e,s0,b →* addr a,s1,False" using CallStatic.hyps(2)[OF iconf] by auto
    have call: "P  eM(ps),s0,b →* addr aM(ps),s1,False" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf call] None CallStatic by auto
    have "P,shp s1 b (ps,False) " by(simp add: bconfs_def)
    then have b2: "P  ps,s1,False [→]* map Val vs,(h2, l2, sh2),False"
      using CallStatic.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsStatic[OF b1 b2 _ CallStatic.hyps(6)] CallStatic.hyps(5) by fastforce
  next
    case (Some a')
    then obtain b1 where b1: "P  e,s0,b →* addr a,s1,b1"
      by (metis (no_types, lifting) CallStatic.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have call: "P  eM(ps),s0,b →* addr aM(ps),s1,b1" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf call] CallStatic by auto
    have bconf2: "P,shp s0 b (ps,b) " using CallStatic.prems Some by simp
    then have "P,shp s1 b (ps,b1) " using Red_preserves_bconf[OF wwf call CallStatic.prems] by simp
    then have b2: "P  ps,s1,b1 [→]* map Val vs,(h2, l2, sh2),False"
      using CallStatic.hyps(4)[OF iconf2'] by auto
    then show ?thesis using CallRedsStatic[OF b1 b2 _ CallStatic.hyps(6)] CallStatic.hyps(5) by fastforce
  qed
next
  case (Call e s0 a s1 ps vs h2 l2 sh2 C fs M Ts T pns body D l2' e' h3 l3 sh3) show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s0) e" using Call.prems(1) by simp
    have bconf: "P,shp s0 b (e,b) " using Call.prems(2) None by simp
    then have b1: "P  e,s0,b →* addr a,s1,False" using Call.hyps(2)[OF iconf] by auto
    have call: "P  eM(ps),s0,b →* addr aM(ps),s1,False" by(rule CallRedsObj[OF b1])
    then have iconf2: "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf call] None Call by auto
    have "P,shp s1 b (ps,False) " by(simp add: bconfs_def)
    then have b2: "P  ps,s1,False [→]* map Val vs,(h2, l2, sh2),False"
      using Call.hyps(4)[OF iconf2] by simp
    have iconf3: "iconf (shp (h2, l2', sh2)) body"
      by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf Call.hyps(6)]])
    have "P,shp (h2, l2', sh2) b (body,False) " by(simp add: bconf_def)
    then have b3: "P  body,(h2, l2', sh2),False →* e',(h3, l3, sh3),False"
      using Call.hyps(10)[OF iconf3] by simp
    show ?thesis by(rule CallRedsFinal[OF wwf b1 b2 Call.hyps(5-8) b3 eval_final[OF Call.hyps(9)]])
  next
    case (Some a')
    then obtain b1 where b1: "P  e,s0,b →* addr a,s1,b1"
      by (metis (no_types, lifting) Call.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have call: "P  eM(ps),s0,b →* addr aM(ps),s1,b1" by(rule CallRedsObj[OF b1])
    then have iconf2': "iconfs (shp s1) ps" using Red_preserves_iconf[OF wwf call] Call by auto
    have bconf2: "P,shp s0 b (ps,b) " using Call.prems Some by simp
    then have "P,shp s1 b (ps,b1) " using Red_preserves_bconf[OF wwf call Call.prems] by simp
    then have b2: "P  ps,s1,b1 [→]* map Val vs,(h2, l2, sh2),False"
      using Call.hyps(4)[OF iconf2'] by auto
    have iconf3: "iconf (shp (h2, l2', sh2)) body"
      by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf Call.hyps(6)]])
    have "P,shp (h2, l2', sh2) b (body,False) " by(simp add: bconf_def)
    then have b3: "P  body,(h2, l2', sh2),False →* e',(h3, l3, sh3),False"
      using Call.hyps(10)[OF iconf3] by simp
    show ?thesis by(rule CallRedsFinal[OF wwf b1 b2 Call.hyps(5-8) b3 eval_final[OF Call.hyps(9)]])
  qed
next
  case (SCallParamsThrow es s0 vs ex es' s2 C M) show ?case
  proof(cases "map_vals_of es")
    case None
    then have iconf: "iconfs (shp s0) es" using SCallParamsThrow.prems(1) by simp
    have bconf: "P,shp s0 b (es,b) " using SCallParamsThrow.prems(2) None by simp
    then have b1: "P  es,s0,b [→]* map Val vs @ throw ex # es',s2,False"
      using SCallParamsThrow.hyps(2)[OF iconf] by simp
    show ?thesis using SCallRedsThrowParams[OF b1] by simp
  next
    case (Some vs')
    then have "es = map Val vs'" by(rule map_vals_of_spec)
    then show ?thesis using evals_finals_same[OF _ SCallParamsThrow.hyps(1)] map_Val_nthrow_neq
      by auto
  qed
next
  case (SCallNone ps s0 vs s2 C M) show ?case
  proof(cases "map_vals_of ps")
    case None
    then have iconf: "iconfs (shp s0) ps" using SCallNone.prems(1) by simp
    have bconf: "P,shp s0 b (ps,b) " using SCallNone.prems(2) None by simp
    then have b1: "P  ps,s0,b [→]* map Val vs,s2,False" using SCallNone.hyps(2)[OF iconf] by auto
    then show ?thesis using SCallRedsNone[OF b1 SCallNone.hyps(3)] SCallNone.hyps(1) by simp
  next
    case (Some vs')
    then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
    then have s0: "s0 = s2" using SCallNone.hyps(1) evals_finals_same by blast
    then show ?thesis using RedSCallNone[OF SCallNone.hyps(3)] ps by(cases s2, auto)
  qed
next
  case (SCallNonStatic ps s0 vs s2 C M Ts T m D) show ?case
  proof(cases "map_vals_of ps")
    case None
    then have iconf: "iconfs (shp s0) ps" using SCallNonStatic.prems(1) by simp
    have bconf: "P,shp s0 b (ps,b) " using SCallNonStatic.prems(2) None by simp
    then have b1: "P  ps,s0,b [→]* map Val vs,s2,False" using SCallNonStatic.hyps(2)[OF iconf] by auto
    then show ?thesis using SCallRedsNonStatic[OF b1 SCallNonStatic.hyps(3)] SCallNonStatic.hyps(1) by simp
  next
    case (Some vs')
    then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
    then have s0: "s0 = s2" using SCallNonStatic.hyps(1) evals_finals_same by blast
    then show ?thesis using RedSCallNonStatic[OF SCallNonStatic.hyps(3)] ps by(cases s2, auto)
  qed
next
  case (SCallInitThrow ps s0 vs h1 l1 sh1 C M Ts T pns body D a s') show ?case
  proof(cases "map_vals_of ps")
    case None
    then have iconf: "iconfs (shp s0) ps" using SCallInitThrow.prems(1) by simp
    have bconf: "P,shp s0 b (ps,b) " using SCallInitThrow.prems(2) None by simp
    then have b1: "P  ps,s0,b [→]* map Val vs,(h1, l1, sh1),False"
      using SCallInitThrow.hyps(2)[OF iconf] by auto
    have bconf2: "P,shp (h1, l1, sh1) b (INIT D ([D],False)  unit,False) " by(simp add: bconf_def)
    then have b2: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* throw a,s',False"
      using SCallInitThrow.hyps(7) by auto
    then show ?thesis using SCallInitThrowReds[OF wwf b1 SCallInitThrow.hyps(3-5)]
      by(cases s', auto)
  next
    case (Some vs')
    have ps: "ps = map Val vs'" by(rule map_vals_of_spec[OF Some])
    then have vs: "vs = vs'  s0 = (h1, l1, sh1)"
      using evals_finals_same[OF _ SCallInitThrow.hyps(1)] map_Val_eq by auto
    show ?thesis
    proof(cases b)
      case True
      obtain sfs where shC: "sh1 D = (sfs, Processing)"
        using SCallInitThrow.hyps(3,4) SCallInitThrow.prems(2) True Some vs
          by(auto simp: bconf_def initPD_def dest: sees_method_fun)
      then show ?thesis using init_ProcessingE[OF _ SCallInitThrow.hyps(6)] by blast
    next
      case False
      then have b1: "P  ps,s0,b [→]* map Val vs,(h1, l1, sh1),False" using ps vs by simp
      have bconf2: "P,shp (h1, l1, sh1) b (INIT D ([D],False)  unit,False) " by(simp add: bconf_def)
      then have b2: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* throw a,s',False"
        using SCallInitThrow.hyps(7) by auto
      then show ?thesis using SCallInitThrowReds[OF wwf b1 SCallInitThrow.hyps(3-5)] by(cases s', auto)
    qed
  qed
next
  case (SCallInit ps s0 vs h1 l1 sh1 C M Ts T pns body D v' h2 l2 sh2 l2' e' h3 l3 sh3) show ?case
  proof(cases "map_vals_of ps")
    case None
    then have iconf: "iconfs (shp s0) ps" using SCallInit.prems(1) by simp
    have bconf: "P,shp s0 b (ps,b) " using SCallInit.prems(2) None by simp
    then have b1: "P  ps,s0,b [→]* map Val vs,(h1, l1, sh1),False"
      using SCallInit.hyps(2)[OF iconf] by auto
    have bconf2: "P,shp (h1, l1, sh1) b (INIT D ([D],False)  unit,False) " by(simp add: bconf_def)
    then have b2: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* Val v',(h2, l2, sh2),False"
      using SCallInit.hyps(7) by auto
    have iconf3: "iconf (shp (h2, l2', sh2)) body"
      by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCallInit.hyps(3)]])
    have "P,shp (h2, l2', sh2) b (body,False) " by(simp add: bconf_def)
    then have b3: "P  body,(h2, l2', sh2),False →* e',(h3, l3, sh3),False"
      using SCallInit.hyps(11)[OF iconf3] by simp
    show ?thesis by(rule SCallInitReds[OF wwf b1 SCallInit.hyps(3-5) b2 SCallInit.hyps(8-9)
                           b3 eval_final[OF SCallInit.hyps(10)]])
  next
    case (Some vs')
    then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
    then have vs: "vs = vs'  s0 = (h1, l1, sh1)"
      using evals_finals_same[OF _ SCallInit.hyps(1)] map_Val_eq by auto
    show ?thesis
    proof(cases b)
      case True
      then have b1: "P  ps,s0,b [→]* map Val vs,(h1, l1, sh1),b" using ps vs by simp
      obtain sfs where shC: "sh1 D = (sfs, Processing)"
        using SCallInit.hyps(3,4) SCallInit.prems(2) True Some vs
          by(auto simp: bconf_def initPD_def dest: sees_method_fun)
      then have s': "(h1, l1, sh1) = (h2, l2, sh2)" using init_ProcessingE[OF _ SCallInit.hyps(6)] by simp
      have iconf3: "iconf (shp (h2, l2', sh2)) body"
        by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCallInit.hyps(3)]])
      have "P,shp (h2, l2', sh2) b (body,False) " by(simp add: bconf_def)
      then have b3: "P  body,(h2, l2', sh2),False →* e',(h3, l3, sh3),False"
        using SCallInit.hyps(11)[OF iconf3] by simp
      then have b3': "P  body,(h1, l2', sh1),False →* e',(h3, l3, sh3),False"
        using s' by simp
      then show ?thesis using SCallInitProcessingReds[OF wwf b1 SCallInit.hyps(3) shC
                           SCallInit.hyps(8-9) b3' eval_final[OF SCallInit.hyps(10)]] s' by simp
    next
      case False
      then have b1: "P  ps,s0,b [→]* map Val vs,(h1, l1, sh1),False" using ps vs by simp
      have bconf2: "P,shp (h1, l1, sh1) b (INIT D ([D],False)  unit,False) " by(simp add: bconf_def)
      then have b2: "P  INIT D ([D],False)  unit,(h1, l1, sh1),False →* Val v',(h2, l2, sh2),False"
        using SCallInit.hyps(7) by auto
      have iconf3: "iconf (shp (h2, l2', sh2)) body"
        by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCallInit.hyps(3)]])
      have "P,shp (h2, l2', sh2) b (body,False) " by(simp add: bconf_def)
      then have b3: "P  body,(h2, l2', sh2),False →* e',(h3, l3, sh3),False"
        using SCallInit.hyps(11)[OF iconf3] by simp
      show ?thesis by(rule SCallInitReds[OF wwf b1 SCallInit.hyps(3-5) b2 SCallInit.hyps(8-9)
                             b3 eval_final[OF SCallInit.hyps(10)]])
    qed
  qed
next
  case (SCall ps s0 vs h2 l2 sh2 C M Ts T pns body D sfs l2' e' h3 l3 sh3) show ?case
  proof(cases "map_vals_of ps")
    case None
    then have iconf: "iconfs (shp s0) ps" using SCall.prems(1) by simp
    have bconf: "P,shp s0 b (ps,b) " using SCall.prems(2) None by simp
    then have b1: "P  ps,s0,b [→]* map Val vs,(h2, l2, sh2),False"
      using SCall.hyps(2)[OF iconf] by auto
    have iconf3: "iconf (shp (h2, l2', sh2)) body"
      by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCall.hyps(3)]])
    have "P,shp (h2, l2', sh2) b (body,False) " by(simp add: bconf_def)
    then have b2: "P  body,(h2, l2', sh2),False →* e',(h3, l3, sh3),False"
      using SCall.hyps(8)[OF iconf3] by simp
    show ?thesis by(rule SCallRedsFinal[OF wwf b1 SCall.hyps(3-6) b2 eval_final[OF SCall.hyps(7)]])
  next
    case (Some vs')
    then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
    then have vs: "vs = vs'  s0 = (h2, l2, sh2)"
      using evals_finals_same[OF _ SCall.hyps(1)] map_Val_eq by auto
    then have b1: "P  ps,s0,b [→]* map Val vs,(h2, l2, sh2),b" using ps by simp
    have iconf3: "iconf (shp (h2, l2', sh2)) body"
      by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCall.hyps(3)]])
    have "P,shp (h2, l2', sh2) b (body,False) " by(simp add: bconf_def)
    then have b2: "P  body,(h2, l2', sh2),False →* e',(h3, l3, sh3),False"
      using SCall.hyps(8)[OF iconf3] by simp
    show ?thesis by(rule SCallRedsFinal[OF wwf b1 SCall.hyps(3-6) b2 eval_final[OF SCall.hyps(7)]])
  qed
next
  case (Block e0 h0 l0 V sh0 e1 h1 l1 sh1 T)
  have iconf: "iconf (shp (h0, l0(V := None), sh0)) e0"
    using Block.prems(1) by (auto simp: assigned_def)
  have bconf: "P,shp (h0, l0(V := None), sh0) b (e0,b) " using Block.prems(2)
    by(auto simp: bconf_def)
  then have b': "P  e0,(h0, l0(V := None), sh0),b →* e1,(h1, l1, sh1),False"
    using Block.hyps(2)[OF iconf] by auto
  have fin: "final e1" using Block by(auto dest: eval_final)
  thus ?case using BlockRedsFinal[OF b' fin] by simp
next
  case (Seq e0 s0 v s1 e1 e2 s2)
  then have iconf: "iconf (shp s0) e0" using Seq.prems(1)
    by(auto dest: val_of_spec lass_val_of_spec)
  have b1: "b1. P  e0,s0,b →* Val v,s1,b1"
  proof(cases "val_of e0")
    case None show ?thesis
    proof(cases "lass_val_of e0")
      case lNone:None
      then have bconf: "P,shp s0 b (e0,b) " using Seq.prems(2) None by simp
      then have "P  e0,s0,b →* Val v,s1,False" using iconf Seq.hyps(2) by auto
      then show ?thesis by fast
    next
      case (Some p)
      obtain V' v' where p: "p = (V',v')" and e0: "e0 = V':=Val v'"
        using lass_val_of_spec[OF Some] by(cases p, auto)
      obtain h l sh h' l' sh' where s0: "s0 = (h,l,sh)" and s1: "s1 = (h',l',sh')" by(cases s0, cases s1)
      then have eval: "P  e0,(h,l,sh)  Val v,(h',l',sh')" using Seq.hyps(1) by simp
      then have s1': "Val v = unit  h' = h  l' = l(V'  v')  sh' = sh"
        using lass_val_of_eval[OF Some eval] p e0 by simp
      then have "P  e0,s0,b  Val v,s1,b" using e0 s0 s1 by(auto intro: RedLAss)
      then show ?thesis by auto
    qed
  next
    case (Some a)
    then have "e0 = Val v" and "s0 = s1" using Seq.hyps(1) eval_cases(3) val_of_spec by blast+
    then show ?thesis using Seq by auto
  qed
  then obtain b1 where b1': "P  e0,s0,b →* Val v,s1,b1" by clarsimp
  have seq: "P  e0;;e1,s0,b →* Val v;;e1,s1,b1" by(rule SeqReds[OF b1'])
  then have iconf2: "iconf (shp s1) e1" using Red_preserves_iconf[OF wwf seq] Seq nsub_RI_iconf
    by auto
  have "P,shp s1 b (Val v;; e1,b1) " by(rule Red_preserves_bconf[OF wwf seq Seq.prems])
  then have bconf2: "P,shp s1 b (e1,b1) " by simp
  have b2: "P  e1,s1,b1 →* e2,s2,False" by(rule Seq.hyps(4)[OF iconf2 bconf2])
  then show ?case using SeqReds2[OF b1' b2] by fast
next
  case (SeqThrow e0 s0 a s1 e1 b)
  have notVal: "val_of e0 = None" "lass_val_of e0 = None"
    using SeqThrow.hyps(1) eval_throw_nonVal eval_throw_nonLAss by auto
  thus ?case using SeqThrow notVal by(auto dest!:eval_final dest: SeqRedsThrow)
next
  case (CondT e s0 s1 e1 e' s2 e2)
  then have iconf: "iconf (shp s0) e" using CondT.prems(1) by auto
  have bconf: "P,shp s0 b (e,b) " using CondT.prems(2) by auto
  then have b1: "P  e,s0,b →* true,s1,False" using iconf CondT.hyps(2) by auto
  have cond: "P  if (e) e1 else e2,s0,b →* if (true) e1 else e2,s1,False" by(rule CondReds[OF b1])
  then have iconf2': "iconf (shp s1) e1" using Red_preserves_iconf[OF wwf cond] CondT nsub_RI_iconf
    by auto
  have "P,shp s1 b (e1,False) " by(simp add: bconf_def)
  then have b2: "P  e1,s1,False →* e',s2,False" using CondT.hyps(4)[OF iconf2'] by auto
  then show ?case using CondReds2T[OF b1 b2] by fast
next
  case (CondF e s0 s1 e2 e' s2 e1)
  then have iconf: "iconf (shp s0) e" using CondF.prems(1) by auto
  have bconf: "P,shp s0 b (e,b) " using CondF.prems(2) by auto
  then have b1: "P  e,s0,b →* false,s1,False" using iconf CondF.hyps(2) by auto
  have cond: "P  if (e) e1 else e2,s0,b →* if (false) e1 else e2,s1,False" by(rule CondReds[OF b1])
  then have iconf2': "iconf (shp s1) e2" using Red_preserves_iconf[OF wwf cond] CondF nsub_RI_iconf
    by auto
  have "P,shp s1 b (e2,False) " by(simp add: bconf_def)
  then have b2: "P  e2,s1,False →* e',s2,False" using CondF.hyps(4)[OF iconf2'] by auto
  then show ?case using CondReds2F[OF b1 b2] by fast
next
  case CondThrow thus ?case by(auto dest!:eval_final dest:CondRedsThrow)
next
  case (WhileF e s0 s1 c)
  then have iconf: "iconf (shp s0) e" using nsub_RI_iconf by auto
  then have bconf: "P,shp s0 b (e,b) " using WhileF.prems(2) by(simp add: bconf_def)
  then have b': "P  e,s0,b →* false,s1,False" using WhileF.hyps(2) iconf by auto
  thus ?case using WhileFReds[OF b'] by fast
next
  case (WhileT e s0 s1 c v1 s2 e3 s3)
  then have iconf: "iconf (shp s0) e" using nsub_RI_iconf by auto
  then have bconf: "P,shp s0 b (e,b) " using WhileT.prems(2) by(simp add: bconf_def)
  then have b1: "P  e,s0,b →* true,s1,False" using WhileT.hyps(2) iconf by auto
  have iconf2: "iconf (shp s1) c" using WhileT.prems(1) nsub_RI_iconf by auto
  have bconf2: "P,shp s1 b (c,False) " by(simp add: bconf_def)
  then have b2: "P  c,s1,False →* Val v1,s2,False" using WhileT.hyps(4) iconf2 by auto
  have iconf3: "iconf (shp s2) (while (e) c)" using WhileT.prems(1) by auto
  have "P,shp s2 b (while (e) c,False) " by(simp add: bconf_def)
  then have b3: "P  while (e) c,s2,False →* e3,s3,False" using WhileT.hyps(6) iconf3 by auto
  show ?case using WhileTReds[OF b1 b2 b3] by fast
next
  case WhileCondThrow thus ?case
    by (metis (no_types, lifting) WhileRedsThrow iconf.simps(16) bconf_While bconf_def nsub_RI_iconf)
next
  case (WhileBodyThrow e s0 s1 c e' s2)
  then have iconf: "iconf (shp s0) e" using nsub_RI_iconf by auto
  then have bconf: "P,shp s0 b (e,b) " using WhileBodyThrow.prems(2) by(simp add: bconf_def)
  then have b1: "P  e,s0,b →* true,s1,False" using WhileBodyThrow.hyps(2) iconf by auto
  have iconf2: "iconf (shp s1) c" using WhileBodyThrow.prems(1) nsub_RI_iconf by auto
  have bconf2: "P,shp s1 b (c,False) " by(simp add: bconf_def)
  then have b2: "P  c,s1,False →* throw e',s2,False" using WhileBodyThrow.hyps(4) iconf2 by auto
  show ?case using WhileTRedsThrow[OF b1 b2] by fast
next
  case Throw thus ?case by (meson ThrowReds iconf.simps(17) bconf_Throw)
next
  case ThrowNull thus ?case by (meson ThrowRedsNull iconf.simps(17) bconf_Throw)
next
  case ThrowThrow thus ?case by (meson ThrowRedsThrow iconf.simps(17) bconf_Throw)
next
  case Try thus ?case by (meson TryRedsVal iconf.simps(18) bconf_Try)
next
  case (TryCatch e1 s0 a h1 l1 sh1 D fs C e2 V e2' h2 l2 sh2)
  then have b1: "P  e1,s0,b →* Throw a,(h1, l1, sh1),False" by auto
  have Try: "P  try e1 catch(C V) e2,s0,b →* try (Throw a) catch(C V) e2,(h1, l1, sh1),False"
    by(rule TryReds[OF b1])
  have iconf: "iconf sh1 e2" using Red_preserves_iconf[OF wwf Try] TryCatch nsub_RI_iconf
    by auto
  have bconf: "P,shp (h1, l1(V  Addr a), sh1) b (e2,False) " by(simp add: bconf_def)
  then have b2: "P  e2,(h1, l1(V  Addr a), sh1),False →* e2',(h2, l2, sh2),False"
    using TryCatch.hyps(6) iconf by auto
  thus ?case using TryCatchRedsFinal[OF b1] TryCatch.hyps(3-5) by (meson eval_final)
next
  case TryThrow thus ?case by (meson TryRedsFail iconf.simps(18) bconf_Try)
next
  case Nil thus ?case by(auto simp: bconfs_def)
next
  case (Cons e s0 v s1 es es' s2) show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s0) e" using Cons.prems(1) by simp
    have bconf: "P,shp s0 b (e,b) " using Cons.prems(2) None by simp
    then have b1: "P  e,s0,b →* Val v,s1,False" using Cons.hyps(2) iconf by auto
    have cons: "P  e # es,s0,b [→]* Val v # es,s1,False" by(rule ListReds1[OF b1])
    then have iconf2': "iconfs (shp s1) es" using Reds_preserves_iconf[OF wwf cons] None Cons by auto
    have "P,shp s1 b (es,False) " by(simp add: bconfs_def)
    then have b2: "P  es,s1,False [→]* es',s2,False" using Cons.hyps(4)[OF iconf2'] by auto
    show ?thesis using ListRedsVal[OF b1 b2] by auto
  next
    case (Some a)
    then obtain b1 where b1: "P  e,s0,b →* Val v,s1,b1"
      by (metis (no_types, lifting) Cons.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have cons: "P  e # es,s0,b [→]* Val v # es,s1,b1" by(rule ListReds1[OF b1])
    then have iconf2': "iconfs (shp s1) es" using Reds_preserves_iconf[OF wwf cons] Cons by auto
    have bconf2: "P,shp s0 b (es,b) " using Cons.prems Some by simp
    then have "P,shp s1 b (es,b1) " using Reds_preserves_bconf[OF wwf cons Cons.prems] by simp
    then have b2: "P  es,s1,b1 [→]* es',s2,False" using Cons.hyps(4)[OF iconf2'] by auto
    show ?thesis using ListRedsVal[OF b1 b2] by auto
  qed
next
  case (ConsThrow e s0 e' s1 es) show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s0) e" using ConsThrow.prems(1) by simp
    have bconf: "P,shp s0 b (e,b) " using ConsThrow.prems(2) None by simp
    then have b1: "P  e,s0,b →* throw e',s1,False" using ConsThrow.hyps(2) iconf by auto
    have cons: "P  e # es,s0,b [→]* throw e' # es,s1,False" by(rule ListReds1[OF b1])
    then show ?thesis by fast
  next
    case (Some a)
    then show ?thesis using eval_final_same[OF ConsThrow.hyps(1)] val_of_spec[OF Some] by auto
  qed
next
  case (InitFinal e s e' s' C b')
  then have "¬sub_RI e" by simp
  then show ?case using InitFinal RedInit[of e C b' s b P]
    by (meson converse_rtrancl_into_rtrancl nsub_RI_iconf red_preserves_bconf RedInit)
next
  case (InitNone sh C C' Cs e h l e' s')
  then have init: "P  INIT C' (C # Cs,False)  e,(h, l, sh(C  (sblank P C, Prepared))),b →* e',s',False"
    by(simp add: bconf_def)
  show ?case by(rule InitNoneReds[OF InitNone.hyps(1) init])
next
  case (InitDone sh C sfs C' Cs e h l e' s')
  then have "iconf (shp (h, l, sh)) (INIT C' (Cs,True)  e)" using InitDone.hyps(1)
  proof(cases Cs)
    case Nil
    then have "C = C'" "¬sub_RI e" using InitDone.prems(1) by simp+
    then show ?thesis using Nil InitDone.hyps(1) by(simp add: initPD_def)
  qed(auto)
  then have init: "P  INIT C' (Cs,True)  e,(h, l, sh),b →* e',s',False"
    using InitDone by(simp add: bconf_def)
  show ?case by(rule InitDoneReds[OF InitDone.hyps(1) init])
next
  case (InitProcessing sh C sfs C' Cs e h l e' s')
  then have "iconf (shp (h, l, sh)) (INIT C' (Cs,True)  e)" using InitProcessing.hyps(1)
  proof(cases Cs)
    case Nil
    then have "C = C'" "¬sub_RI e" using InitProcessing.prems(1) by simp+
    then show ?thesis using Nil InitProcessing.hyps(1) by(simp add: initPD_def)
  qed(auto)
  then have init: "P  INIT C' (Cs,True)  e,(h, l, sh),b →* e',s',False"
    using InitProcessing by(simp add: bconf_def)
  show ?case by(rule InitProcessingReds[OF InitProcessing.hyps(1) init])
next
  case InitError thus ?case by(fastforce intro: InitErrorReds simp: bconf_def)
next
  case InitObject thus ?case by(fastforce intro: InitObjectReds simp: bconf_def)
next
  case InitNonObject thus ?case by(fastforce intro: InitNonObjectReds simp: bconf_def)
next
  case InitRInit thus ?case by(fastforce intro: RedsInitRInit simp: bconf_def)
next
  case (RInit e s v h' l' sh' C sfs i sh'' C' Cs e' e1 s1)
  then have iconf2: "iconf (shp (h', l', sh'')) (INIT C' (Cs,True)  e')"
    by(auto simp: initPD_def fun_upd_same list_nonempty_induct)
  show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s) e" using RInit.prems(1) by simp
    have bconf: "P,shp s b (e,b) " using RInit.prems(2) None by simp
    then have b1: "P  e,s,b →* Val v,(h',l',sh'),False" using RInit.hyps(2)[OF iconf] by auto
    have "P,shp (h', l', sh'') b (INIT C' (Cs,True)  e',False) " by(simp add: bconf_def)
    then have b2: "P  INIT C' (Cs,True)  e',(h',l',sh''),False →* e1,s1,False"
      using RInit.hyps(7)[OF iconf2] by auto
    then show ?thesis using RedsRInit[OF b1 RInit.hyps(3-5) b2] by fast
  next
    case (Some a')
    then obtain b1 where b1: "P  e,s,b →* Val v,(h',l',sh'),b1"
      by (metis (no_types, lifting) RInit.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fin: "final e" by(simp add: val_of_spec[OF Some])
    have "¬b" using RInit.prems(2) Some by(simp add: bconf_def)
    then have nb1: "¬b1" using reds_final_same[OF b1 fin] by simp
    have "P,shp (h', l', sh'') b (INIT C' (Cs,True)  e',b1) " using nb1
      by(simp add: bconf_def)
    then have b2: "P  INIT C' (Cs,True)  e',(h', l', sh''),b1 →* e1,s1,False"
      using RInit.hyps(7)[OF iconf2] by auto
    then show ?thesis using RedsRInit[OF b1 RInit.hyps(3-5) b2] by fast
  qed
next
  case (RInitInitFail e s a h' l' sh' C sfs i sh'' D Cs e' e1 s1)
  have fin: "final (throw a)" using eval_final[OF RInitInitFail.hyps(1)] by simp
  then obtain a' where a': "throw a = Throw a'" by auto
  have iconf2: "iconf (shp (h', l', sh'')) (RI (D,Throw a') ; Cs  e')"
    using RInitInitFail.prems(1) by auto
  show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s) e" using RInitInitFail.prems(1) by simp
    have bconf: "P,shp s b (e,b) " using RInitInitFail.prems(2) None by simp
    then have b1: "P  e,s,b →* Throw a',(h',l',sh'),False"
      using RInitInitFail.hyps(2)[OF iconf] a' by auto
    have "P,shp (h', l', sh'') b (RI (D,Throw a') ; Cs  e',False) " by(simp add: bconf_def)
    then have b2: "P  RI (D,Throw a') ; Cs  e',(h',l',sh''),False →* e1,s1,False"
      using RInitInitFail.hyps(6) iconf2 a' by auto
    show ?thesis using RInitInitThrowReds[OF b1 RInitInitFail.hyps(3-4) b2] by fast
  next
    case (Some a1)
    then obtain b1 where b1: "P  e,s,b →* Throw a',(h',l',sh'),b1" using a'
      by (metis (no_types, lifting) RInitInitFail.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
    have fin: "final e" by(simp add: val_of_spec[OF Some])
    have "¬b" using RInitInitFail.prems(2) Some by(simp add: bconf_def)
    then have nb1: "¬b1" using reds_final_same[OF b1 fin] by simp
    have "P,shp (h', l', sh'') b (RI (D,Throw a') ; Cs  e',b1) " using nb1
      by(simp add: bconf_def)
    then have b2: "P  RI (D,Throw a') ; Cs  e',(h', l', sh''),b1 →* e1,s1,False"
      using RInitInitFail.hyps(6) iconf2 a' by auto
    show ?thesis using RInitInitThrowReds[OF b1 RInitInitFail.hyps(3-4) b2] by fast
  qed
next
  case (RInitFailFinal e s a h' l' sh' C sfs i sh'' e')
  have fin: "final (throw a)" using eval_final[OF RInitFailFinal.hyps(1)] by simp
  then obtain a' where a': "throw a = Throw a'" by auto
  show ?case
  proof(cases "val_of e")
    case None
    then have iconf: "iconf (shp s) e" using RInitFailFinal.prems(1) by simp
    have bconf: "P,shp s b (e,b) " using RInitFailFinal.prems(2) None by simp
    then have b1: "P  e,s,b →* Throw a',(h',l',sh'),False"
      using RInitFailFinal.hyps(2)[OF iconf] a' by auto
    show ?thesis using RInitThrowReds[OF b1 RInitFailFinal.hyps(3-4)] a' by fast
  next
    case (Some a1)
    then show ?thesis using eval_final_same[OF RInitFailFinal.hyps(1)] val_of_spec[OF Some] by auto
  qed
qed
(*>*)


subsection‹Big steps simulates small step›

text‹ This direction was carried out by Norbert Schirmer and Daniel
Wasserrab (and modified to include statics and DCI by Susannah Mansky). ›

text ‹ The big step equivalent of @{text RedWhile}: › 

lemma unfold_while: 
  "P  while(b) c,s  e',s'  =  P  if(b) (c;;while(b) c) else (unit),s  e',s'"
(*<*)
proof
  assume "P  while (b) c,s  e',s'"
  thus "P  if (b) (c;; while (b) c) else unit,s  e',s'"
    by cases (fastforce intro: eval_evals.intros)+
next
  assume "P  if (b) (c;; while (b) c) else unit,s  e',s'"
  thus "P  while (b) c,s  e',s'"
  proof (cases)
    fix a
    assume e': "e' = throw a"
    assume "P  b,s  throw a,s'"  
    hence "P  while(b) c,s  throw a,s'" by (rule WhileCondThrow)
    with e' show ?thesis by simp
  next
    fix s1
    assume eval_false: "P  b,s  false,s1"
    and eval_unit: "P  unit,s1  e',s'"
    with eval_unit have "s' = s1" "e' = unit" by (auto elim: eval_cases)
    moreover from eval_false have "P  while (b) c,s  unit,s1"
      by - (rule WhileF, simp)
    ultimately show ?thesis by simp
  next
    fix s1
    assume eval_true: "P  b,s  true,s1"
    and eval_rest: "P  c;; while (b) c,s1e',s'"
    from eval_rest show ?thesis
    proof (cases)
      fix s2 v1
      assume "P  c,s1  Val v1,s2" "P  while (b) c,s2  e',s'"
      with eval_true show "P  while(b) c,s  e',s'" by (rule WhileT)
    next
      fix a
      assume "P  c,s1  throw a,s'" "e' = throw a"
      with eval_true show "P  while(b) c,s  e',s'"        
        by (iprover intro: WhileBodyThrow)
    qed
  qed
qed
(*>*)


lemma blocksEval:
  "Ts vs l l'. size ps = size Ts; size ps = size vs; P  blocks(ps,Ts,vs,e),(h,l,sh)  e',(h',l',sh') 
      l''. P  e,(h,l(ps[↦]vs),sh)  e',(h',l'',sh')"
(*<*)
proof (induct ps)
  case Nil then show ?case by fastforce
next
  case (Cons p ps')
  have length_eqs: "length (p # ps') = length Ts" 
                   "length (p # ps') = length vs" by fact+
  then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
  obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
  have "P  blocks (p # ps', Ts, vs, e),(h,l,sh)  e',(h', l',sh')" by fact
  with Ts vs 
  have "P  {p:T := Val v; blocks (ps', Ts', vs', e)},(h,l,sh)  e',(h', l',sh')"
    by simp
  then obtain l''' where
    eval_ps': "P  blocks (ps', Ts', vs', e),(h, l(pv), sh)  e',(h', l''', sh')"
    and l''': "l'=l'''(p:=l p)"
    by (auto elim!: eval_cases)
  then obtain l'' where 
    hyp: "P  e,(h, l(pv)(ps'[↦]vs'), sh)  e',(h', l'', sh')"
    using length_eqs Ts vs Cons.hyps [OF _ _ eval_ps'] by auto
  from hyp
  show "l''. P  e,(h, l(p # ps'[↦]vs), sh)  e',(h', l'', sh')"
    using Ts vs by auto
qed
(*>*)

lemma
assumes wf: "wwf_J_prog P"
shows eval_restrict_lcl:
  "P  e,(h,l,sh)  e',(h',l',sh')  (W. fv e  W  P  e,(h,l|`W,sh)  e',(h',l'|`W,sh'))"
and "P  es,(h,l,sh) [⇒] es',(h',l',sh')  (W. fvs es  W  P  es,(h,l|`W,sh) [⇒] es',(h',l'|`W,sh'))"
(*<*)
proof(induct rule:eval_evals_inducts)
  case (Block e0 h0 l0 V sh0 e1 h1 l1 sh1 T)
  have IH: "W. fv e0  W  P  e0,(h0,l0(V:=None)|`W,sh0)  e1,(h1,l1|`W,sh1)" by fact
  have "fv({V:T; e0})  W" by fact+
  hence "fv e0 - {V}  W" by simp_all
  hence "fv e0  insert V W" by fast
  from IH[OF this]
  have "P  e0,(h0, (l0|`W)(V := None), sh0)  e1,(h1, l1|`insert V W, sh1)"
    by fastforce
  from eval_evals.Block[OF this] show ?case by fastforce
next
  case Seq thus ?case by simp (blast intro:eval_evals.Seq)
next
  case New thus ?case by(simp add:eval_evals.intros)
next
  case NewFail thus ?case by(simp add:eval_evals.intros)
next
  case (NewInit sh C h l v' h' l' sh' a h'')
  have "fv(INIT C ([C],False)  unit)  W" by simp
  then have "P  INIT C ([C],False)  unit,(h, l |` W, sh)  Val v',(h', l' |` W, sh')"
    by (simp add: NewInit.hyps(3))
  thus ?case using NewInit.hyps(1,4-6) eval_evals.NewInit by blast
next
  case (NewInitOOM sh C h l v' h' l' sh')
  have "fv(INIT C ([C],False)  unit)  W" by simp
  then have "P  INIT C ([C],False)  unit,(h, l |` W, sh)  Val v',(h', l' |` W, sh')"
    by (simp add: NewInitOOM.hyps(3))
  thus ?case
    using NewInitOOM.hyps(1,4,5) eval_evals.NewInitOOM by auto
next
  case NewInitThrow thus ?case by(simp add:eval_evals.intros)
next
  case Cast thus ?case by simp (blast intro:eval_evals.Cast)
next
  case CastNull thus ?case by simp (blast intro:eval_evals.CastNull)
next
  case CastFail thus ?case by simp (blast intro:eval_evals.CastFail)
next
  case CastThrow thus ?case by(simp add:eval_evals.intros)
next
  case Val thus ?case by(simp add:eval_evals.intros)
next
  case BinOp thus ?case by simp (blast intro:eval_evals.BinOp)
next
  case BinOpThrow1 thus ?case by simp (blast intro:eval_evals.BinOpThrow1)
next
  case BinOpThrow2 thus ?case by simp (blast intro:eval_evals.BinOpThrow2)
next
  case Var thus ?case by(simp add:eval_evals.intros)
next
  case (LAss e h0 l0 sh0 v h l sh l' V)
  have IH: "W. fv e  W  P  e,(h0,l0|`W,sh0)  Val v,(h,l|`W,sh)"
   and [simp]: "l' = l(V  v)" by fact+
  have "fv (V:=e)  W" by fact
  hence fv: "fv e  W" and VinW: "V  W" by auto
  from eval_evals.LAss[OF IH[OF fv] refl, of V] VinW
  show ?case by simp
next
  case LAssThrow thus ?case by(fastforce intro: eval_evals.LAssThrow)
next
  case FAcc thus ?case by simp (blast intro: eval_evals.FAcc)
next
  case FAccNull thus ?case by(fastforce intro: eval_evals.FAccNull)
next
  case FAccThrow thus ?case by(fastforce intro: eval_evals.FAccThrow)
next
  case FAccNone thus ?case by(metis eval_evals.FAccNone fv.simps(7))
next
  case FAccStatic thus ?case by(metis eval_evals.FAccStatic fv.simps(7))
next
  case SFAcc thus ?case by simp (blast intro: eval_evals.SFAcc)
next
  case SFAccInit thus ?case by simp (blast intro: eval_evals.SFAccInit)
next
  case SFAccInitThrow thus ?case by simp (blast intro: eval_evals.SFAccInitThrow)
next
  case SFAccNone thus ?case by simp (blast intro: eval_evals.SFAccNone)
next
  case SFAccNonStatic thus ?case by simp (blast intro: eval_evals.SFAccNonStatic)
next
  case FAss thus ?case by simp (blast intro: eval_evals.FAss)
next
  case FAssNull thus ?case by simp (blast intro: eval_evals.FAssNull)
next
  case FAssThrow1 thus ?case by simp (blast intro: eval_evals.FAssThrow1)
next
  case FAssThrow2 thus ?case by simp (blast intro: eval_evals.FAssThrow2)
next
  case FAssNone thus ?case by simp (blast intro: eval_evals.FAssNone)
next
  case FAssStatic thus ?case by simp (blast intro: eval_evals.FAssStatic)
next
  case SFAss thus ?case by simp (blast intro: eval_evals.SFAss)
next
  case SFAssInit thus ?case by simp (blast intro: eval_evals.SFAssInit)
next
  case SFAssInitThrow thus ?case by simp (blast intro: eval_evals.SFAssInitThrow)
next
  case SFAssThrow thus ?case by simp (blast intro: eval_evals.SFAssThrow)
next
  case SFAssNone thus ?case by simp (blast intro: eval_evals.SFAssNone)
next
  case SFAssNonStatic thus ?case by simp (blast intro: eval_evals.SFAssNonStatic)
next
  case CallObjThrow thus ?case by simp (blast intro: eval_evals.intros)
next
  case CallNull thus ?case by simp (blast intro: eval_evals.CallNull)
next
  case (CallNone e h l sh a h' l' sh' ps vs h2 l2 sh2 C fs M)
  have f1: "P  e,(h, l |` W, sh)  addr a,(h', l' |` W, sh')"
    by (metis (no_types) fv.simps(11) le_sup_iff local.CallNone(2) local.CallNone(7))
  have "P  ps,(h', l' |` W, sh') [⇒] map Val vs, (h2, l2 |` W, sh2)"
    using local.CallNone(4) local.CallNone(7) by auto
  then show ?case
    using f1 eval_evals.CallNone local.CallNone(5) local.CallNone(6) by auto
next
  case CallStatic thus ?case
    by (metis (no_types, lifting) eval_evals.CallStatic fv.simps(11) le_sup_iff)
next
  case CallParamsThrow thus ?case
    by simp (blast intro: eval_evals.CallParamsThrow)
next
  case (Call e h0 l0 sh0 a h1 l1 sh1 ps vs h2 l2 sh2 C fs M Ts T pns body
      D l2' e' h3 l3 sh3)
  have IHe: "W. fv e  W  P  e,(h0,l0|`W,sh0)  addr a,(h1,l1|`W,sh1)"
   and IHps: "W. fvs ps  W  P  ps,(h1,l1|`W,sh1) [⇒] map Val vs,(h2,l2|`W,sh2)"
   and IHbd: "W. fv body  W  P  body,(h2,l2'|`W,sh2)  e',(h3,l3|`W,sh3)"
   and h2a: "h2 a = Some (C, fs)"
   and "method": "P  C sees M,NonStatic: TsT = (pns, body) in D"
   and same_len: "size vs = size pns"
   and l2': "l2' = [this  Addr a, pns [↦] vs]" by fact+
  have "fv (eM(ps))  W" by fact
  hence fve: "fv e   W" and fvps: "fvs(ps)  W" by auto
  have wfmethod: "size Ts = size pns  this  set pns" and
       fvbd: "fv body  {this}  set pns"
    using "method" wf by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  show ?case
    using IHbd[OF fvbd] l2' same_len wfmethod h2a
      eval_evals.Call[OF IHe[OF fve] IHps[OF fvps] _ "method" same_len l2']
    by (simp add:subset_insertI)
next
  case (SCallNone ps h l sh vs h' l' sh' C M)
  have "P  ps,(h, l |` W, sh) [⇒] map Val vs,(h', l' |` W, sh')"
    using SCallNone.hyps(2) SCallNone.prems by auto
  then show ?case using SCallNone.hyps(3) eval_evals.SCallNone by auto
next
  case SCallNonStatic thus ?case by (metis eval_evals.SCallNonStatic fv.simps(12))
next
  case SCallParamsThrow thus ?case
    by simp (blast intro: eval_evals.SCallParamsThrow)
next
  case SCallInitThrow thus ?case by simp (blast intro: eval_evals.SCallInitThrow)
next
  case SCallInit thus ?case by simp (blast intro: eval_evals.SCallInit)
next
  case (SCall ps h0 l0 sh0 vs h2 l2 sh2 C M Ts T pns body D sfs l2' e' h3 l3 sh3)
  have IHps: "W. fvs ps  W  P  ps,(h0,l0|`W,sh0) [⇒] map Val vs,(h2,l2|`W,sh2)"
   and IHbd: "W. fv body  W  P  body,(h2,l2'|`W,sh2)  e',(h3,l3|`W,sh3)"
   and sh2D: "sh2 D = Some (sfs, Done)  M = clinit  sh2 D = (sfs, Processing)"
   and "method": "P  C sees M,Static: TsT = (pns, body) in D"
   and same_len: "size vs = size pns"
   and l2': "l2' = [pns [↦] vs]" by fact+
  have "fv (CsM(ps))  W" by fact
  hence fvps: "fvs(ps)  W" by auto
  have wfmethod: "size Ts = size pns" and fvbd: "fv body  set pns"
    using "method" wf by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  show ?case
    using IHbd[OF fvbd] l2' same_len wfmethod sh2D
      eval_evals.SCall[OF IHps[OF fvps] "method" _ same_len l2']
    by (simp add:subset_insertI)
next
  case SeqThrow thus ?case by simp (blast intro: eval_evals.SeqThrow)
next
  case CondT thus ?case by simp (blast intro: eval_evals.CondT)
next
  case CondF thus ?case by simp (blast intro: eval_evals.CondF)
next
  case CondThrow thus ?case by simp (blast intro: eval_evals.CondThrow)
next
  case WhileF thus ?case by simp (blast intro: eval_evals.WhileF)
next
  case WhileT thus ?case by simp (blast intro: eval_evals.WhileT)
next
  case WhileCondThrow thus ?case by simp (blast intro: eval_evals.WhileCondThrow)
next
  case WhileBodyThrow thus ?case by simp (blast intro: eval_evals.WhileBodyThrow)
next
  case Throw thus ?case by simp (blast intro: eval_evals.Throw)
next
  case ThrowNull thus ?case by simp (blast intro: eval_evals.ThrowNull)
next
  case ThrowThrow thus ?case by simp (blast intro: eval_evals.ThrowThrow)
next
  case Try thus ?case by simp (blast intro: eval_evals.Try)
next
  case (TryCatch e1 h0 l0 sh0 a h1 l1 sh1 D fs C e2 V e2' h2 l2 sh2)
  have IH1: "W. fv e1  W  P  e1,(h0,l0|`W,sh0)  Throw a,(h1,l1|`W,sh1)"
   and IH2: "W. fv e2  W  P  e2,(h1,l1(VAddr a)|`W,sh1)  e2',(h2,l2|`W,sh2)"
   and lookup: "h1 a = Some(D, fs)" and subtype: "P  D * C" by fact+
  have "fv (try e1 catch(C V) e2)  W" by fact
  hence fv1: "fv e1  W" and fv2: "fv e2  insert V W" by auto
  have IH2': "P  e2,(h1,(l1|`W)(V  Addr a),sh1)  e2',(h2,l2|`insert V W,sh2)"
    using IH2[OF fv2] fun_upd_restrict[of l1 W] (*FIXME just l|W instead of l|(W-V) in simp rule??*) by simp
  with eval_evals.TryCatch[OF IH1[OF fv1] _ subtype IH2'] lookup
  show ?case by fastforce
next
  case TryThrow thus ?case by simp (blast intro: eval_evals.TryThrow)
next
  case Nil thus ?case by (simp add: eval_evals.Nil)
next
  case Cons thus ?case by simp (blast intro: eval_evals.Cons)
next
  case ConsThrow thus ?case by simp (blast intro: eval_evals.ConsThrow)
next
  case InitFinal thus ?case by (simp add: eval_evals.InitFinal)
next
  case InitNone thus ?case by(blast intro: eval_evals.InitNone)
next
  case InitDone thus ?case
    by (simp add: InitDone.hyps(2) InitDone.prems eval_evals.InitDone)
next
  case InitProcessing thus ?case by (simp add: eval_evals.InitProcessing)
next
  case InitError thus ?case using eval_evals.InitError by auto
next
  case InitObject thus ?case by(simp add: eval_evals.InitObject)
next
  case InitNonObject thus ?case by(simp add: eval_evals.InitNonObject)
next
  case InitRInit thus ?case by(simp add: eval_evals.InitRInit)
next
  case (RInit e h l sh v h' l' sh' C sfs i sh'' C' Cs e' e1 h1 l1 sh1)
  have f1: "fv e  W  fv (INIT C' (Cs,True)  e')  W"
    using RInit.prems by auto
  then have f2: "P  e,(h, l |` W, sh)  Val v,(h', l' |` W, sh')"
    using RInit.hyps(2) by blast
  have "P  INIT C' (Cs,True)  e', (h', l' |` W, sh'')  e1,(h1, l1 |` W, sh1)"
    using f1 by (meson RInit.hyps(7))
  then show ?case
    using f2 RInit.hyps(3) RInit.hyps(4) RInit.hyps(5) eval_evals.RInit by blast
next
  case (RInitInitFail e h l sh a h' l' sh' C sfs i sh'' D Cs e' e1 h1 l1 sh1)
  have f1: "fv e  W" "fv e'  W"
    using RInitInitFail.prems by auto
  then have f2: "P  e,(h, l |` W, sh)  throw a,(h', l' |` W, sh')"
    using RInitInitFail.hyps(2) by blast
  then have f2': "fv (throw a)  W"
    using eval_final[OF f2] by auto
  then have f1': "fv (RI (D,throw a);Cs  e')  W"
    using f1 by auto
  have "P  RI (D,throw a);Cs  e', (h', l' |` W, sh'')  e1,(h1, l1 |` W, sh1)"
    using f1' by (meson RInitInitFail.hyps(6))
  then show ?case
    using f2 by (simp add: RInitInitFail.hyps(3,4) eval_evals.RInitInitFail)
next
  case (RInitFailFinal e h l sh a h' l' sh' sh'' C)
  have f1: "fv e  W"
    using RInitFailFinal.prems by auto
  then have f2: "P  e,(h, l |` W, sh)  throw a,(h', l' |` W, sh')"
    using RInitFailFinal.hyps(2) by blast
  then have f2': "fv (throw a)  W"
    using eval_final[OF f2] by auto
  then show ?case using f2 RInitFailFinal.hyps(3,4) eval_evals.RInitFailFinal by blast
qed
(*>*)


lemma eval_notfree_unchanged:
  "P  e,(h,l,sh)  e',(h',l',sh')  (V. V  fv e  l' V = l V)"
and "P  es,(h,l,sh) [⇒] es',(h',l',sh')  (V. V  fvs es  l' V = l V)"
(*<*)
proof(induct rule:eval_evals_inducts)
  case LAss thus ?case by(simp add:fun_upd_apply)
next
  case Block thus ?case
    by (simp only:fun_upd_apply split:if_splits) fastforce
next
  case TryCatch thus ?case
    by (simp only:fun_upd_apply split:if_splits) fastforce
next
  case (RInitInitFail e h l sh a h' l' sh' C sfs i sh'' D Cs e1 h1 l1 sh1)
  have "fv (throw a) = {}"
    using RInitInitFail.hyps(1) eval_final final_fv by blast 
  then have "fv e  fv (RI (D,throw a) ; Cs  unit)  fv (RI (C,e) ; D#Cs  unit)" 
    by auto
  then show ?case using RInitInitFail.hyps(2,6) RInitInitFail.prems by fastforce
qed simp_all
(*>*)


lemma eval_closed_lcl_unchanged:
  " P  e,(h,l,sh)  e',(h',l',sh'); fv e = {}   l' = l"
(*<*)by(fastforce dest:eval_notfree_unchanged simp add:fun_eq_iff [where 'b="val option"])(*>*)


lemma list_eval_Throw: 
assumes eval_e: "P  throw x,s  e',s'"
shows "P  map Val vs @ throw x # es',s [⇒] map Val vs @ e' # es',s'"
(*<*)
proof -
  from eval_e 
  obtain a where e': "e' = Throw a"
    by (cases) (auto dest!: eval_final)
  {
    fix es
    have "vs. es = map Val vs @ throw x # es' 
            P  es,s[⇒]map Val vs @ e' # es',s'"
    proof (induct es type: list)
      case Nil thus ?case by simp
    next
      case (Cons e es vs)
      have e_es: "e # es = map Val vs @ throw x # es'" by fact
      show "P  e # es,s [⇒] map Val vs @ e' # es',s'"
      proof (cases vs)
        case Nil
        with e_es obtain "e=throw x" "es=es'" by simp
        moreover from eval_e e'
        have "P  throw x # es,s [⇒] Throw a # es,s'"
          by (iprover intro: ConsThrow)
        ultimately show ?thesis using Nil e' by simp
      next
        case (Cons v vs')
        have vs: "vs = v # vs'" by fact
        with e_es obtain 
          e: "e=Val v" and es:"es= map Val vs' @ throw x # es'"
          by simp
        from e 
        have "P  e,s  Val v,s"
          by (iprover intro: eval_evals.Val)
        moreover from es 
        have "P  es,s [⇒] map Val vs' @ e' # es',s'"
          by (rule Cons.hyps)
        ultimately show 
          "P  e#es,s [⇒] map Val vs @ e' # es',s'"
          using vs by (auto intro: eval_evals.Cons)
      qed
    qed
  }
  thus ?thesis
    by simp
qed
(*>*)

― ‹ separate evaluation of first subexp of a sequence ›
lemma seq_ext:
assumes IH: "e' s'. P  e'',s''  e',s'  P  e,s  e',s'"
 and seq: "P  e'' ;; e0,s''  e',s'"
shows "P  e ;; e0,s  e',s'"
proof(rule eval_cases(14)[OF seq]) ― ‹ Seq ›
  fix v' s1 assume e'': "P  e'',s''  Val v',s1" and estep: "P  e0,s1  e',s'"
  have "P  e,s  Val v',s1" using e'' IH by simp
  then show ?thesis using estep Seq by simp
next
  fix et assume e'': "P  e'',s''  throw et,s'" and e': "e' = throw et"
  have "P  e,s  throw et,s'" using e'' IH by simp
  then show ?thesis using eval_evals.SeqThrow e' by simp
qed

― ‹ separate evaluation of @{text RI} subexp, val case ›
lemma rinit_Val_ext:
assumes ri: "P  RI (C,e'') ; Cs  e0,s''  Val v',s1"
 and IH: "e' s'. P  e'',s''  e',s'  P  e,s  e',s'"
shows "P  RI (C,e) ; Cs  e0,s  Val v',s1"
proof(rule eval_cases(20)[OF ri]) ― ‹ RI ›
  fix v'' h' l' sh' sfs i
  assume e''step: "P  e'',s''  Val v'',(h', l', sh')"
     and shC: "sh' C = (sfs, i)"
     and init: "P  INIT (if Cs = [] then C else last Cs) (Cs,True)  e0,(h', l', sh'(C  (sfs, Done))) 
        Val v',s1"
  have "P  e,s  Val v'',(h', l', sh')" using IH[OF e''step] by simp
  then show ?thesis using RInit init shC by auto
next
  fix a h' l' sh' sfs i D Cs'
  assume e''step: "P  e'',s''  throw a,(h', l', sh')"
     and riD: "P  RI (D,throw a) ; Cs'  e0,(h', l', sh'(C  (sfs, Error)))  Val v',s1"
  have "P  e,s  throw a,(h', l', sh')" using IH[OF e''step] by simp
  then show ?thesis using riD rinit_throwE by blast
qed(simp)

― ‹ separate evaluation of @{text RI} subexp, throw case ›
lemma rinit_throw_ext:
assumes ri: "P  RI (C,e'') ; Cs  e0,s''  throw et,s'"
 and IH: "e' s'. P  e'',s''  e',s'  P  e,s  e',s'"
shows "P  RI (C,e) ; Cs  e0,s  throw et,s'"
proof(rule eval_cases(20)[OF ri]) ― ‹ RI ›
  fix v h' l' sh' sfs i
  assume e''step: "P  e'',s''  Val v,(h', l', sh')"
     and shC: "sh' C = (sfs, i)"
     and init: "P  INIT (if Cs = [] then C else last Cs) (Cs,True)  e0,(h', l', sh'(C  (sfs, Done))) 
        throw et,s'"
  have "P  e,s  Val v,(h', l', sh')" using IH[OF e''step] by simp
  then show ?thesis using RInit init shC by auto
next
  fix a h' l' sh' sfs i D Cs'
  assume e''step: "P  e'',s''  throw a,(h', l', sh')"
     and shC: "sh' C = (sfs, i)"
     and riD: "P  RI (D,throw a) ; Cs'  e0,(h', l', sh'(C  (sfs, Error)))  throw et,s'"
     and cons: "Cs = D # Cs'"
  have estep': "P  e,s  throw a,(h', l', sh')" using IH[OF e''step] by simp
  then show ?thesis using RInitInitFail cons riD shC by simp
next
  fix a h' l' sh' sfs i
  assume "throw et = throw a"
     and "s' = (h', l', sh'(C  (sfs, Error)))"
     and "P  e'',s''  throw a,(h', l', sh')"
     and "sh' C = (sfs, i)"
     and "Cs = []"
  then show ?thesis using RInitFailFinal IH by auto
qed

― ‹ separate evaluation of @{text RI} subexp ›
lemma rinit_ext:
assumes IH: "e' s'. P  e'',s''  e',s'  P  e,s  e',s'"
shows "e' s'. P  RI (C,e'') ; Cs  e0,s''  e',s'
  P  RI (C,e) ; Cs  e0,s  e',s'"
proof -
  fix e' s' assume ri'': "P  RI (C,e'') ; Cs  e0,s''  e',s'"
  then have "final e'" using eval_final by simp
  then show "P  RI (C,e) ; Cs  e0,s  e',s'"
  proof(rule finalE)
    fix v assume "e' = Val v" then show ?thesis using rinit_Val_ext[OF _ IH] ri'' by simp
  next
    fix a assume "e' = throw a" then show ?thesis using rinit_throw_ext[OF _ IH] ri'' by simp
  qed
qed

― ‹ @{text INIT} and @{text RI} return either @{text Val} with @{text Done} or
 @{text Processing} flag or @{text Throw} with @{text Error} flag ›
lemma
shows eval_init_return: "P  e,s  e',s'
   iconf (shp s) e
   (Cs b. e = INIT C' (Cs,b)  unit)  (C e0 Cs ei. e = RI(C,e0);Cs@[C']  unit)
      (e0. e = RI(C',e0);Nil  unit)
   (val_of e' = Some v  (sfs i. shp s' C' = (sfs,i)  (i = Done  i = Processing)))
    (throw_of e' = Some a  (sfs i. shp s' C' = (sfs,Error)))"
and "P  es,s [⇒] es',s'  True"
proof(induct rule: eval_evals.inducts)
  case (InitFinal e s e' s' C b) then show ?case
    by(fastforce simp: initPD_def dest: eval_final_same)
next
  case (InitDone sh C sfs C' Cs e h l e' s')
  then have "final e'" using eval_final by simp
  then show ?case
  proof(rule finalE)
    fix v assume e': "e' = Val v" then show ?thesis using InitDone initPD_def
    proof(cases Cs) qed(auto)
  next
    fix a assume e': "e' = throw a" then show ?thesis using InitDone initPD_def
    proof(cases Cs) qed(auto)
  qed
next
  case (InitProcessing sh C sfs C' Cs e h l e' s')
  then have "final e'" using eval_final by simp
  then show ?case
  proof(rule finalE)
    fix v assume e': "e' = Val v" then show ?thesis using InitProcessing initPD_def
    proof(cases Cs) qed(auto)
  next
    fix a assume e': "e' = throw a" then show ?thesis using InitProcessing initPD_def
    proof(cases Cs) qed(auto)
  qed
next
  case (InitError sh C sfs Cs e h l e' s' C') show ?case
  proof(cases Cs)
    case Nil then show ?thesis using InitError by simp
  next
    case (Cons C2 list)
    then have "final e'" using InitError eval_final by simp
    then show ?thesis
    proof(rule finalE)
      fix v assume e': "e' = Val v" then show ?thesis
      using InitError
      proof -
        obtain ccss :: "char list list" and bb :: bool where
          "INIT C' (C # Cs,False)  e = INIT C' (ccss,bb)  unit"
          using InitError.prems(2) by blast
        then show ?thesis using InitError.hyps(2) e' by(auto dest!: rinit_throwE)
      qed
    next
      fix a assume e': "e' = throw a"
      then show ?thesis using Cons InitError cons_to_append[of list] by clarsimp
    qed
  qed
next
  case (InitRInit C Cs h l sh e' s' C') show ?case
  proof(cases Cs)
    case Nil then show ?thesis using InitRInit by simp
  next
    case (Cons C' list) then show ?thesis
      using InitRInit Cons cons_to_append[of list] by clarsimp
  qed
next
  case (RInit e s v h' l' sh' C sfs i sh'' C' Cs e' e1 s1)
  then have final: "final e1" using eval_final by simp
  then show ?case
  proof(cases Cs)
    case Nil show ?thesis using final
    proof(rule finalE)
      fix v assume e': "e1 = Val v" show ?thesis
      using RInit Nil by(auto simp: fun_upd_same initPD_def)
    next
      fix a assume e': "e1 = throw a" show ?thesis
      using RInit Nil by(auto simp: fun_upd_same initPD_def)
    qed
  next
    case (Cons a list) show ?thesis
    proof(rule finalE[OF final])
      fix v assume e': "e1 = Val v" then show ?thesis
      using RInit Cons by clarsimp (metis last.simps last_appendR list.distinct(1))
    next
      fix a assume e': "e1 = throw a" then show ?thesis
      using RInit Cons by clarsimp (metis last.simps last_appendR list.distinct(1))
    qed
  qed
next
  case (RInitInitFail e s a h' l' sh' C sfs i sh'' D Cs e' e1 s1)
  then have final: "final e1" using eval_final by simp
  then show ?case
  proof(rule finalE)
    fix v assume e': "e1 = Val v" then show ?thesis
    using RInitInitFail by clarsimp (meson exp.distinct(101) rinit_throwE)
  next
    fix a' assume e': "e1 = Throw a'"
    then have "iconf (sh'(C  (sfs, Error))) a"
      using RInitInitFail.hyps(1) eval_final by fastforce
    then show ?thesis using RInitInitFail e'
      by clarsimp (meson Cons_eq_append_conv list.inject)
  qed
qed(auto simp: fun_upd_same)

lemma init_Val_PD: "P  INIT C' (Cs,b)  unit,s  Val v,s'
   iconf (shp s) (INIT C' (Cs,b)  unit)
   sfs i. shp s' C' = (sfs,i)  (i = Done  i = Processing)"
 by(drule_tac v = v in eval_init_return, simp+)

lemma init_throw_PD: "P  INIT C' (Cs,b)  unit,s  throw a,s'
   iconf (shp s) (INIT C' (Cs,b)  unit)
   sfs i. shp s' C' = (sfs,Error)"
 by(drule_tac a = a in eval_init_return, simp+)

lemma rinit_Val_PD: "P  RI(C,e0);Cs  unit,s  Val v,s'
   iconf (shp s) (RI(C,e0);Cs  unit)  last(C#Cs) = C'
   sfs i. shp s' C' = (sfs,i)  (i = Done  i = Processing)"
apply(drule_tac C' = C' and v = v in eval_init_return, simp_all)
apply (metis append_butlast_last_id)
done

lemma rinit_throw_PD: "P  RI(C,e0);Cs  unit,s  throw a,s'
   iconf (shp s) (RI(C,e0);Cs  unit)  last(C#Cs) = C'
   sfs i. shp s' C' = (sfs,Error)"
apply(drule_tac C' = C' and a = a in eval_init_return, simp_all)
apply (metis append_butlast_last_id)
done

― ‹ combining the above to get evaluation of @{text INIT} in a sequence ›

(* Hiermit kann man die ganze pair-Splitterei in den automatischen Taktiken
abschalten. Wieder anschalten siehe nach dem Beweis. *)
(*<*)
declare split_paired_All [simp del] split_paired_Ex [simp del]
(*>*)

lemma eval_init_seq': "P  e,s  e',s'
   (C Cs b ei. e = INIT C (Cs,b)  ei)  (C e0 Cs ei. e = RI(C,e0);Cs  ei)
   (C Cs b ei. e = INIT C (Cs,b)  ei  P  (INIT C (Cs,b)  unit);; ei,s  e',s')
      (C e0 Cs ei. e = RI(C,e0);Cs  ei  P  (RI(C,e0);Cs  unit);; ei,s  e',s')"
and "P  es,s [⇒] es',s'  True"
proof(induct rule: eval_evals.inducts)
  case InitFinal then show ?case by(auto simp: Seq[OF eval_evals.InitFinal[OF Val[where v=Unit]]])
next
  case (InitNone sh) then show ?case
   using seq_ext[OF eval_evals.InitNone[where sh=sh and e=unit, OF InitNone.hyps(1)]] by fastforce
next
  case (InitDone sh) then show ?case
   using seq_ext[OF eval_evals.InitDone[where sh=sh and e=unit, OF InitDone.hyps(1)]] by fastforce
next
  case (InitProcessing sh) then show ?case
   using seq_ext[OF eval_evals.InitProcessing[where sh=sh and e=unit, OF InitProcessing.hyps(1)]]
     by fastforce
next
  case (InitError sh) then show ?case
   using seq_ext[OF eval_evals.InitError[where sh=sh and e=unit, OF InitError.hyps(1)]] by fastforce
next
  case (InitObject sh) then show ?case
   using seq_ext[OF eval_evals.InitObject[where sh=sh and e=unit, OF InitObject.hyps(1)]]
     by fastforce
next
  case (InitNonObject sh) then show ?case
   using seq_ext[OF eval_evals.InitNonObject[where sh=sh and e=unit, OF InitNonObject.hyps(1)]]
     by fastforce
next
  case (InitRInit C Cs e h l sh e' s' C') then show ?case
   using seq_ext[OF eval_evals.InitRInit[where e=unit]] by fastforce
next
  case RInit then show ?case
   using seq_ext[OF eval_evals.RInit[where e=unit, OF RInit.hyps(1)]] by fastforce
next
  case RInitInitFail then show ?case
   using seq_ext[OF eval_evals.RInitInitFail[where e=unit, OF RInitInitFail.hyps(1)]] by fastforce
next
  case RInitFailFinal
  then show ?case using eval_evals.RInitFailFinal eval_evals.SeqThrow by auto
qed(auto)

lemma eval_init_seq: "P  INIT C (Cs,b)  e,(h, l, sh)  e',s'
  P  (INIT C (Cs,b)  unit);; e,(h, l, sh)  e',s'"
 by(auto dest: eval_init_seq')


text ‹ The key lemma: ›
lemma
assumes wf: "wwf_J_prog P"
shows extend_1_eval: "P  e,s,b  e'',s'',b''  P,shp s b (e,b) 
    (s' e'.  P  e'',s''  e',s'  P  e,s  e',s')"
and extend_1_evals: "P  es,s,b [→] es'',s'',b''  P,shp s b (es,b) 
    (s' es'. P  es'',s'' [⇒] es',s'  P  es,s [⇒] es',s')"
proof (induct rule: red_reds.inducts)
  case (RedNew h a C FDTs h' l sh)
  then have e':"e' = addr a" and s':"s' = (h(a  blank P C), l, sh)"
    using eval_cases(3) by fastforce+
  obtain sfs i where shC: "sh C = (sfs, i)" and "i = Done  i = Processing"
   using RedNew by (clarsimp simp: bconf_def initPD_def)
  then show ?case
  proof(cases i)
    case Done then show ?thesis using RedNew shC e' s' New by simp
  next
    case Processing
    then have shC': "sfs. sh C = Some(sfs,Done)" and shP: "sh C = Some(sfs,Processing)"
      using shC by simp+
    then have init: "P  INIT C ([C],False)  unit,(h,l,sh)  unit,(h,l,sh)"
      by(simp add: InitFinal InitProcessing Val)
    have "P  new C,(h, l, sh)  addr a,(h(a  blank P C),l,sh)"
      using RedNew shC' by(auto intro: NewInit[OF _ init])
    then show ?thesis using e' s' by simp
  qed(auto)
next
  case (RedNewFail h C l sh)
  then have e':"e' = THROW OutOfMemory" and s':"s' = (h, l, sh)"
    using eval_final_same final_def by fastforce+
  obtain sfs i where shC: "sh C = (sfs, i)" and "i = Done  i = Processing"
   using RedNewFail by (clarsimp simp: bconf_def initPD_def)
  then show ?case
  proof(cases i)
    case Done then show ?thesis using RedNewFail shC e' s' NewFail by simp
  next
    case Processing
    then have shC': "sfs. sh C = Some(sfs,Done)" and shP: "sh C = Some(sfs,Processing)"
      using shC by simp+
    then have init: "P  INIT C ([C],False)  unit,(h,l,sh)  unit,(h,l,sh)"
      by(simp add: InitFinal InitProcessing Val)
    have "P  new C,(h, l, sh)  THROW OutOfMemory,(h,l,sh)"
      using RedNewFail shC' by(auto intro: NewInitOOM[OF _ init])
    then show ?thesis using e' s' by simp
  qed(auto)
next
  case (NewInitRed sh C h l)
  then have seq: "P  (INIT C ([C],False)  unit);; new C,(h, l, sh)  e',s'"
    using eval_init_seq by simp
  then show ?case
  proof(rule eval_cases(14)) ― ‹ Seq ›
    fix v s1 assume init: "P  INIT C ([C],False)  unit,(h, l, sh)  Val v,s1"
      and new: "P  new C,s1  e',s'"
    obtain h1 l1 sh1 where s1: "s1 = (h1,l1,sh1)" by(cases s1)
    then obtain sfs i where shC: "sh1 C = (sfs, i)" and iDP: "i = Done  i = Processing"
      using init_Val_PD[OF init] by auto
    show ?thesis
    proof(rule eval_cases(1)[OF new]) ― ‹ New ›
      fix sha ha a FDTs la
      assume s1a: "s1 = (ha, la, sha)" and e': "e' = addr a"
         and s': "s' = (ha(a  blank P C), la, sha)"
         and addr: "new_Addr ha = a" and fields: "P  C has_fields FDTs"
      then show ?thesis using NewInit[OF _ _ addr fields] NewInitRed.hyps init by simp
    next
      fix sha ha la
      assume "s1 = (ha, la, sha)" and "e' = THROW OutOfMemory"
         and "s' = (ha, la, sha)" and "new_Addr ha = None"
      then show ?thesis using NewInitOOM NewInitRed.hyps init by simp
    next
      fix sha ha la v' h' l' sh' a FDTs
      assume s1a: "s1 = (ha, la, sha)" and e': "e' = addr a"
         and s': "s' = (h'(a  blank P C), l', sh')"
         and shaC: "sfs. sha C  (sfs, Done)"
         and init': "P  INIT C ([C],False)  unit,(ha, la, sha)  Val v',(h', l', sh')"
         and addr: "new_Addr h' = a" and fields: "P  C has_fields FDTs"
      then have i: "i = Processing" using iDP shC s1 by simp
      then have "(h', l', sh') = (ha, la, sha)" using init' init_ProcessingE s1 s1a shC by blast
      then show ?thesis using NewInit NewInitRed.hyps s1a addr fields init shaC e' s' by auto
    next
      fix sha ha la v' h' l' sh'
      assume s1a: "s1 = (ha, la, sha)" and e': "e' = THROW OutOfMemory"
         and s': "s' = (h', l', sh')" and "sfs. sha C  (sfs, Done)"
         and init': "P  INIT C ([C],False)  unit,(ha, la, sha)  Val v',(h', l', sh')"
         and addr: "new_Addr h' = None"
      then have i: "i = Processing" using iDP shC s1 by simp
      then have "(h', l', sh') = (ha, la, sha)" using init' init_ProcessingE s1 s1a shC by blast
      then show ?thesis
        using NewInitOOM NewInitRed.hyps e' addr s' s1a init by auto
    next
      fix sha ha la a
      assume s1a: "s1 = (ha, la, sha)"
         and "sfs. sha C  (sfs, Done)"
         and init': "P  INIT C ([C],False)  unit,(ha, la, sha)  throw a,s'"
      then have i: "i = Processing" using iDP shC s1 by simp
      then show ?thesis using init' init_ProcessingE s1 s1a shC by blast
    qed
  next
    fix e assume e': "e' = throw e"
      and init: "P  INIT C ([C],False)  unit,(h, l, sh)  throw e,s'"
    obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
    then obtain sfs i where shC: "sh' C = (sfs, i)" and iDP: "i = Error"
      using init_throw_PD[OF init] by auto
    then show ?thesis by (simp add: NewInitRed.hyps NewInitThrow e' init)
  qed
next
  case CastRed then show ?case
    by(fastforce elim!: eval_cases intro: eval_evals.intros intro!: CastFail)
next
  case RedCastNull
  then show ?case
    by simp (iprover elim: eval_cases intro: eval_evals.intros)
next
  case RedCast
  then show ?case
    by (auto elim: eval_cases intro: eval_evals.intros)
next
  case RedCastFail
  then show ?case
    by (auto elim!: eval_cases intro: eval_evals.intros)
next
  case BinOpRed1 then show ?case
    by(fastforce elim!: eval_cases intro: eval_evals.intros simp: val_no_step)
next
  case BinOpRed2
  thus ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
  case RedBinOp
  thus ?case
    by simp (iprover elim: eval_cases intro: eval_evals.intros)
next
  case RedVar
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case LAssRed thus ?case
    by(fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedLAss
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case FAccRed thus ?case
    by(fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedFAcc then show ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedFAccNull then show ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
  case RedFAccNone thus ?case
    by(fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedFAccStatic thus ?case
    by(fastforce elim: eval_cases intro: eval_evals.intros)
next
  case (RedSFAcc C F t D sh sfs i v h l)
  then have e':"e' = Val v" and s':"s' = (h, l, sh)"
    using eval_cases(3) by fastforce+
  have "i = Done  i = Processing" using RedSFAcc by (clarsimp simp: bconf_def initPD_def)
  then show ?case
  proof(cases i)
    case Done then show ?thesis using RedSFAcc e' s' SFAcc by simp
  next
    case Processing
    then have shC': "sfs. sh D = Some(sfs,Done)" and shP: "sh D = Some(sfs,Processing)"
      using RedSFAcc by simp+
    then have init: "P  INIT D ([D],False)  unit,(h,l,sh)  unit,(h,l,sh)"
      by(simp add: InitFinal InitProcessing Val)
    have "P  CsF{D},(h, l, sh)  Val v,(h,l,sh)"
      by(rule SFAccInit[OF RedSFAcc.hyps(1) shC' init shP RedSFAcc.hyps(3)])
    then show ?thesis using e' s' by simp
  qed(auto)
next
  case (SFAccInitRed C F t D sh h l)
  then have seq: "P  (INIT D ([D],False)  unit);; CsF{D},(h, l, sh)  e',s'"
    using eval_init_seq by simp
  then show ?case
  proof(rule eval_cases(14)) ― ‹ Seq ›
    fix v s1 assume init: "P  INIT D ([D],False)  unit,(h, l, sh)  Val v,s1"
      and acc: "P  CsF{D},s1  e',s'"
    obtain h1 l1 sh1 where s1: "s1 = (h1,l1,sh1)" by(cases s1)
    then obtain sfs i where shD: "sh1 D = (sfs, i)" and iDP: "i = Done  i = Processing"
      using init_Val_PD[OF init] by auto
    show ?thesis
    proof(rule eval_cases(8)[OF acc]) ― ‹ SFAcc ›
      fix t sha sfs v ha la
      assume "s1 = (ha, la, sha)" and "e' = Val v"
         and "s' = (ha, la, sha)" and "P  C has F,Static:t in D"
         and "sha D = (sfs, Done)" and "sfs F = v"
      then show ?thesis using SFAccInit SFAccInitRed.hyps(2) init by auto
    next
      fix t sha ha la v' h' l' sh' sfs i' v
      assume s1a: "s1 = (ha, la, sha)" and e': "e' = Val v"
         and s': "s' = (h', l', sh')" and field: "P  C has F,Static:t in D"
         and "sfs. sha D  (sfs, Done)"
         and init': "P  INIT D ([D],False)  unit,(ha, la, sha)  Val v',(h', l', sh')"
         and shD': "sh' D = (sfs, i')" and sfsF: "sfs F = v"
      then have i: "i = Processing" using iDP shD s1 by simp
      then have "(h', l', sh') = (ha, la, sha)" using init' init_ProcessingE s1 s1a shD by blast
      then show ?thesis using SFAccInit SFAccInitRed.hyps(2) e' s' field init s1a sfsF shD' by auto
    next
      fix t sha ha la a
      assume s1a: "s1 = (ha, la, sha)" and "e' = throw a"
         and "P  C has F,Static:t in D" and "sfs. sha D  (sfs, Done)"
         and init': "P  INIT D ([D],False)  unit,(ha, la, sha)  throw a,s'"
      then have i: "i = Processing" using iDP shD s1 by simp
      then show ?thesis using init' init_ProcessingE s1 s1a shD by blast
    next
      assume "b t. ¬ P  C has F,b:t in D"
      then show ?thesis using SFAccInitRed.hyps(1) by blast
    next
      fix t assume field: "P  C has F,NonStatic:t in D"
      then show ?thesis using has_field_fun[OF SFAccInitRed.hyps(1) field] by simp
    qed
  next
    fix e assume e': "e' = throw e"
     and init: "P  INIT D ([D],False)  unit,(h, l, sh)  throw e,s'"
    obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
    then obtain sfs i where shC: "sh' D = (sfs, i)" and iDP: "i = Error"
      using init_throw_PD[OF init] by auto
    then show ?thesis
      using SFAccInitRed.hyps(1) SFAccInitRed.hyps(2) SFAccInitThrow e' init by auto
  qed
next
  case RedSFAccNone thus ?case
    by(fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedSFAccNonStatic thus ?case
    by(fastforce elim: eval_cases intro: eval_evals.intros)
next
  case (FAssRed1 e s b e1 s1 b1 F D e2)
  obtain h' l' sh' where "s'=(h',l',sh')" by(cases s')
  with FAssRed1 show ?case
    by(fastforce elim!: eval_cases(9)[where e1=e1] intro: eval_evals.intros simp: val_no_step
                 intro!: FAss FAssNull FAssNone FAssStatic FAssThrow2)
next
  case FAssRed2
  obtain h' l' sh' where "s'=(h',l',sh')" by(cases s')
  with FAssRed2 show ?case
    by(auto elim!: eval_cases intro: eval_evals.intros
            intro!: FAss FAssNull FAssNone FAssStatic FAssThrow2 Val)
next
  case RedFAss
  thus ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
  case RedFAssNull
  thus ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
  case RedFAssNone
  then show ?case
    by(auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
  case RedFAssStatic
  then show ?case
    by(auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
  case (SFAssRed e s b e'' s'' b'' C F D)
  obtain h l sh where [simp]: "s = (h,l,sh)" by(cases s)
  obtain h' l' sh' where [simp]: "s'=(h',l',sh')" by(cases s')
  have "val_of e = None" using val_no_step SFAssRed.hyps(1) by(meson option.exhaust)
  then have bconf: "P,sh b (e,b) " using SFAssRed by simp
  show ?case using SFAssRed.prems(2) SFAssRed bconf
  proof cases
    case 2 with SFAssRed bconf show ?thesis by(auto intro!: SFAssInit)
  next
    case 3 with SFAssRed bconf show ?thesis by(auto intro!: SFAssInitThrow)
  qed(auto intro: eval_evals.intros intro!: SFAss SFAssInit SFAssNone SFAssNonStatic)
next
  case (RedSFAss C F t D sh sfs i sfs' v sh' h l)
  let ?sfs' = "sfs(F  v)"
  have e':"e' = unit" and s':"s' = (h, l, sh(D  (?sfs', i)))"
    using RedSFAss eval_cases(3) by fastforce+
  have "i = Done  i = Processing" using RedSFAss by(clarsimp simp: bconf_def initPD_def)
  then show ?case
  proof(cases i)
    case Done then show ?thesis using RedSFAss e' s' SFAss Val by auto
  next
    case Processing
    then have shC': "sfs. sh D = Some(sfs,Done)" and shP: "sh D = Some(sfs,Processing)"
      using RedSFAss by simp+
    then have init: "P  INIT D ([D],False)  unit,(h,l,sh)  unit,(h,l,sh)"
      by(simp add: InitFinal InitProcessing Val)
    have "P  CsF{D} := Val v,(h, l, sh)  unit,(h,l,sh(D  (?sfs', i)))"
      using Processing by(auto intro: SFAssInit[OF Val RedSFAss.hyps(1) shC' init shP])
    then show ?thesis using e' s' by simp
  qed(auto)
next
  case (SFAssInitRed C F t D sh v h l)
  then have seq: "P  (INIT D ([D],False)  unit);; CsF{D} := Val v,(h, l, sh)  e',s'"
    using eval_init_seq by simp
  then show ?case
  proof(rule eval_cases(14)) ― ‹ Seq ›
    fix v' s1 assume init: "P  INIT D ([D],False)  unit,(h, l, sh)  Val v',s1"
      and acc: "P  CsF{D} := Val v,s1  e',s'"
    obtain h1 l1 sh1 where s1: "s1 = (h1,l1,sh1)" by(cases s1)
    then obtain sfs i where shD: "sh1 D = (sfs, i)" and iDP: "i = Done  i = Processing"
      using init_Val_PD[OF init] by auto
    show ?thesis
    proof(rule eval_cases(10)[OF acc]) ― ‹ SFAss ›
      fix va h1 l1 sh1 t sfs
      assume e': "e' = unit" and s': "s' = (h1, l1, sh1(D  (sfs(F  va), Done)))"
         and val: "P  Val v,s1  Val va,(h1, l1, sh1)"
         and field: "P  C has F,Static:t in D" and shD': "sh1 D = (sfs, Done)"
      have "v = va" and "s1 = (h1, l1, sh1)" using eval_final_same[OF val] by auto
      then show ?thesis using SFAssInit field SFAssInitRed.hyps(2) shD' e' s' init val
        by (metis eval_final eval_finalId)
    next
      fix va h1 l1 sh1 t v' h' l' sh' sfs i'
      assume e': "e' = unit" and s': "s' = (h', l', sh'(D  (sfs(F  va), i')))"
         and val: "P  Val v,s1  Val va,(h1, l1, sh1)"
         and field: "P  C has F,Static:t in D" and nDone: "sfs. sh1 D  (sfs, Done)"
         and init': "P  INIT D ([D],False)  unit,(h1, l1, sh1)  Val v',(h', l', sh')"
         and shD': "sh' D = (sfs, i')"
      have v: "v = va" and s1a: "s1 = (h1, l1, sh1)" using eval_final_same[OF val] by auto
      then have i: "i = Processing" using iDP shD s1 nDone by simp
      then have "(h1, l1, sh1) = (h', l', sh')" using init' init_ProcessingE s1 s1a shD by blast
      then show ?thesis using SFAssInit SFAssInitRed.hyps(2) e' s' field init v s1a shD' val
        by (metis eval_final eval_finalId)
    next
      fix va h1 l1 sh1 t a
      assume "e' = throw a" and val: "P  Val v,s1  Val va,(h1, l1, sh1)"
         and "P  C has F,Static:t in D" and nDone: "sfs. sh1 D  (sfs, Done)"
         and init': "P  INIT D ([D],False)  unit,(h1, l1, sh1)  throw a,s'"
      have v: "v = va" and s1a: "s1 = (h1, l1, sh1)" using eval_final_same[OF val] by auto
      then have i: "i = Processing" using iDP shD s1 nDone by simp
      then have "(h1, l1, sh1) = s'" using init' init_ProcessingE s1 s1a shD by blast
      then show ?thesis using init' init_ProcessingE s1 s1a shD i by blast
    next
      fix e'' assume val:"P  Val v,s1  throw e'',s'"
      then show ?thesis using eval_final_same[OF val] by simp
    next
      assume "b t. ¬ P  C has F,b:t in D"
      then show ?thesis using SFAssInitRed.hyps(1) by blast
    next
      fix t assume field: "P  C has F,NonStatic:t in D"
      then show ?thesis using has_field_fun[OF SFAssInitRed.hyps(1) field] by simp
    qed
  next
    fix e assume e': "e' = throw e"
     and init: "P  INIT D ([D],False)  unit,(h, l, sh)  throw e,s'"
    obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
    then obtain sfs i where shC: "sh' D = (sfs, i)" and iDP: "i = Error"
      using init_throw_PD[OF init] by auto
    then show ?thesis using SFAssInitRed.hyps(1) SFAssInitRed.hyps(2) SFAssInitThrow Val
      by (metis e' init)
  qed
next
  case (RedSFAssNone C F D v s b) then show ?case
    by(cases s) (auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
  case (RedSFAssNonStatic C F t D v s b) then show ?case
    by(cases s) (auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
  case CallObj
  note val_no_step[simp]
  from CallObj.prems(2) CallObj show ?case
  proof cases
    case 2 with CallObj show ?thesis by(fastforce intro!: CallParamsThrow)
  next
    case 3 with CallObj show ?thesis by(fastforce intro!: CallNull)
  next
    case 4 with CallObj show ?thesis by(fastforce intro!: CallNone)
  next
    case 5 with CallObj show ?thesis by(fastforce intro!: CallStatic)
  qed(fastforce intro!: CallObjThrow Call)+
next
  case (CallParams es s b es'' s'' b'' v M s')
  then obtain h' l' sh' where "s' = (h',l',sh')" by(cases s')
  with CallParams show ?case
   by(auto elim!: eval_cases intro!: CallNone eval_finalId CallStatic Val)
     (auto intro!: CallParamsThrow CallNull Call Val)
next
  case (RedCall h a C fs M Ts T pns body D vs l sh b)
  have "P  addr a,(h,l,sh)  addr a,(h,l,sh)" by (rule eval_evals.intros)
  moreover
  have finals: "finals(map Val vs)" by simp
  with finals have "P  map Val vs,(h,l,sh) [⇒] map Val vs,(h,l,sh)"
    by (iprover intro: eval_finalsId)
  moreover have "h a = Some (C, fs)" using RedCall by simp
  moreover have "method": "P  C sees M,NonStatic: TsT = (pns, body) in D" by fact
  moreover have same_len1: "length Ts = length pns"
   and this_distinct: "this  set pns" and fv: "fv (body)  {this}  set pns"
    using "method" wf by (fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  have same_len: "length vs = length pns" by fact
  moreover
  obtain l2' where l2': "l2' = [thisAddr a,pns[↦]vs]" by simp
  moreover
  obtain h3 l3 sh3 where s': "s' = (h3,l3,sh3)" by (cases s')
  have eval_blocks:
    "P  (blocks (this # pns, Class D # Ts, Addr a # vs, body)),(h,l,sh)  e',s'" by fact
  hence id: "l3 = l" using fv s' same_len1 same_len
    by(fastforce elim: eval_closed_lcl_unchanged)
  from eval_blocks obtain l3' where "P  body,(h,l2',sh)  e',(h3,l3',sh3)"
  proof -
    from same_len1 have "length(this#pns) = length(Class D#Ts)" by simp
    moreover from same_len1 same_len
    have same_len2: "length (this#pns) = length (Addr a#vs)" by simp
    moreover from eval_blocks
    have "P  blocks (this#pns,Class D#Ts,Addr a#vs,body),(h,l,sh)
              e',(h3,l3,sh3)" using s' same_len1 same_len2 by simp
    ultimately obtain l''
      where "P  body,(h,l(this # pns[↦]Addr a # vs),sh)e',(h3, l'',sh3)"
      by (blast dest:blocksEval)
    from eval_restrict_lcl[OF wf this fv] this_distinct same_len1 same_len
    have "P  body,(h,[this # pns[↦]Addr a # vs],sh) 
               e',(h3, l''|`(set(this#pns)),sh3)" using wf method
      by(simp add:subset_insert_iff insert_Diff_if)
    thus ?thesis by(fastforce intro!:that simp add: l2')
  qed
  ultimately
  have "P  (addr a)M(map Val vs),(h,l,sh)  e',(h3,l,sh3)" by (rule Call)
  with s' id show ?case by simp
next
  case RedCallNull
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros eval_finalsId)
next
  case (RedCallNone h a C fs M vs l sh b)
  then have tes: "THROW NoSuchMethodError = e'  (h,l,sh) = s'"
    using eval_final_same by simp
  have "P  addr a,(h,l,sh)  addr a,(h,l,sh)" and "P  map Val vs,(h,l,sh) [⇒] map Val vs,(h,l,sh)"
    using eval_finalId eval_finalsId by auto
  then show ?case using RedCallNone CallNone tes by auto
next
  case (RedCallStatic h a C fs M Ts T m D vs l sh b)
  then have tes: "THROW IncompatibleClassChangeError = e'  (h,l,sh) = s'"
    using eval_final_same by simp
  have "P  addr a,(h,l,sh)  addr a,(h,l,sh)" and "P  map Val vs,(h,l,sh) [⇒] map Val vs,(h,l,sh)"
    using eval_finalId eval_finalsId by auto
  then show ?case using RedCallStatic CallStatic tes by fastforce
next
  case (SCallParams es s b es'' s'' b' C M s')
  obtain h' l' sh' where s'[simp]: "s' = (h',l',sh')" by(cases s')
  obtain h l sh where s[simp]: "s = (h,l,sh)" by(cases s)
  have es: "map_vals_of es = None" using vals_no_step SCallParams.hyps(1) by (meson not_Some_eq)
  have bconf: "P,sh b (es,b) " using s SCallParams.prems(1) by (simp add: bconf_SCall[OF es])
  from SCallParams.prems(2) SCallParams bconf show ?case
  proof cases
    case 2 with SCallParams bconf show ?thesis by(auto intro!: SCallNone)
  next
    case 3 with SCallParams bconf show ?thesis by(auto intro!: SCallNonStatic)
  next
    case 4 with SCallParams bconf show ?thesis by(auto intro!: SCallInitThrow)
  next
    case 5 with SCallParams bconf show ?thesis by(auto intro!: SCallInit)
  qed(auto intro!: SCallParamsThrow SCall)
next
  case (RedSCall C M Ts T pns body D vs s)
  then obtain h l sh where s:"s = (h,l,sh)" by(cases s)
  then obtain sfs i where shC: "sh D = (sfs, i)" and "i = Done  i = Processing"
   using RedSCall by(auto simp: bconf_def initPD_def dest: sees_method_fun)
  have finals: "finals(map Val vs)" by simp
  with finals have mVs: "P  map Val vs,(h,l,sh) [⇒] map Val vs,(h,l,sh)"
    by (iprover intro: eval_finalsId)
  obtain sfs i where shC: "sh D = (sfs, i)"
   using RedSCall s by(auto simp: bconf_def initPD_def dest: sees_method_fun)
  then have iDP: "i = Done  i = Processing" using RedSCall s
    by (auto simp: bconf_def initPD_def dest: sees_method_fun[OF RedSCall.hyps(1)])
  have "method": "P  C sees M,Static: TsT = (pns, body) in D" by fact
  have same_len1: "length Ts = length pns" and fv: "fv (body)  set pns"
    using "method" wf by (fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
  have same_len: "length vs = length pns" by fact
  obtain l2' where l2': "l2' = [pns[↦]vs]" by simp
  obtain h3 l3 sh3 where s': "s' = (h3,l3,sh3)" by (cases s')
  have eval_blocks:
    "P  (blocks (pns, Ts, vs, body)),(h,l,sh)  e',s'" using RedSCall.prems(2) s by simp
  hence id: "l3 = l" using fv s' same_len1 same_len
    by(fastforce elim: eval_closed_lcl_unchanged)
  from eval_blocks obtain l3' where body: "P  body,(h,l2',sh)  e',(h3,l3',sh3)"
  proof -
    from eval_blocks
    have "P  blocks (pns,Ts,vs,body),(h,l,sh)
              e',(h3,l3,sh3)" using s' same_len same_len1 by simp
    then obtain l''
      where "P  body,(h,l(pns[↦]vs),sh)  e',(h3, l'',sh3)"
      by (blast dest:blocksEval[OF same_len1[THEN sym] same_len[THEN sym]])
    from eval_restrict_lcl[OF wf this fv] same_len1 same_len
    have "P  body,(h,[pns[↦]vs],sh)  e',(h3, l''|`(set(pns)),sh3)" using wf method
      by(simp add:subset_insert_iff insert_Diff_if)
    thus ?thesis by(fastforce intro!:that simp add: l2')
  qed
  show ?case using iDP
  proof(cases i)
    case Done
    then have shC': "sh D = (sfs, Done)  M = clinit  sh D = (sfs, Processing)"
      using shC by simp
    have "P  CsM(map Val vs),(h,l,sh)  e',(h3,l,sh3)"
     by (rule SCall[OF mVs method shC' same_len l2' body])
    with s s' id show ?thesis by simp
  next
    case Processing
    then have shC': "sfs. sh D = Some(sfs,Done)" and shP: "sh D = Some(sfs,Processing)"
      using shC by simp+
    then have init: "P  INIT D ([D],False)  unit,(h,l,sh)  unit,(h,l,sh)"
      by(simp add: InitFinal InitProcessing Val)
    have "P  CsM(map Val vs),(h,l,sh)  e',(h3,l,sh3)"
    proof(cases "M = clinit")
      case False show ?thesis by(rule SCallInit[OF mVs method shC' False init same_len l2' body])
    next
      case True
      then have shC': "sh D = (sfs, Done)  M = clinit  sh D = (sfs, Processing)"
        using shC Processing by simp
      have "P  CsM(map Val vs),(h,l,sh)  e',(h3,l,sh3)"
       by (rule SCall[OF mVs method shC' same_len l2' body])
      with s s' id show ?thesis by simp
    qed
    with s s' id show ?thesis by simp
  qed(auto)
next
  case (SCallInitRed C M Ts T pns body D sh vs h l)
  then have seq: "P  (INIT D ([D],False)  unit);; CsM(map Val vs),(h, l, sh)  e',s'"
    using eval_init_seq by simp
  then show ?case
  proof(rule eval_cases(14)) ― ‹ Seq ›
    fix v' s1 assume init: "P  INIT D ([D],False)  unit,(h, l, sh)  Val v',s1"
      and call: "P  CsM(map Val vs),s1  e',s'"
    obtain h1 l1 sh1 where s1: "s1 = (h1,l1,sh1)" by(cases s1)
    then obtain sfs i where shD: "sh1 D = (sfs, i)" and iDP: "i = Done  i = Processing"
      using init_Val_PD[OF init] by auto
    show ?thesis
    proof(rule eval_cases(12)[OF call]) ― ‹ SCall ›
      fix vsa ex es' assume "P  map Val vs,s1 [⇒] map Val vsa @ throw ex # es',s'"
      then show ?thesis using evals_finals_same by (meson finals_def map_Val_nthrow_neq)
    next
      assume "b Ts T a ba x. ¬ P  C sees M, b :  TsT = (a, ba) in x"
      then show ?thesis using SCallInitRed.hyps(1) by auto
    next
      fix Ts T m D assume "P  C sees M, NonStatic :  TsT = m in D"
      then show ?thesis using sees_method_fun[OF SCallInitRed.hyps(1)] by blast
    next
      fix vsa h1 l1 sh1 Ts T pns body D' a
      assume "e' = throw a" and vals: "P  map Val vs,s1 [⇒] map Val vsa,(h1, l1, sh1)"
         and method: "P  C sees M, Static :  TsT = (pns, body) in D'"
         and nDone: "sfs. sh1 D'  (sfs, Done)"
         and init': "P  INIT D' ([D'],False)  unit,(h1, l1, sh1)  throw a,s'"
      have vs: "vs = vsa" and s1a: "s1 = (h1, l1, sh1)"
        using evals_finals_same[OF _ vals] map_Val_eq by auto
      have D: "D = D'" using sees_method_fun[OF SCallInitRed.hyps(1) method] by simp
      then have i: "i = Processing" using iDP shD s1 s1a nDone by simp
      then show ?thesis using D init' init_ProcessingE s1 s1a shD by blast
    next
      fix vsa h1 l1 sh1 Ts T pns' body' D' v' h2 l2 sh2 h3 l3 sh3
      assume s': "s' = (h3, l2, sh3)"
         and vals: "P  map Val vs,s1 [⇒] map Val vsa,(h1, l1, sh1)"
         and method: "P  C sees M, Static :  TsT = (pns', body') in D'"
         and nDone: "sfs. sh1 D'  (sfs, Done)"
         and init': "P  INIT D' ([D'],False)  unit,(h1, l1, sh1)  Val v',(h2, l2, sh2)"
         and len: "length vsa = length pns'"
         and bstep: "P  body',(h2, [pns' [↦] vsa], sh2)  e',(h3, l3, sh3)"
      have vs: "vs = vsa" and s1a: "s1 = (h1, l1, sh1)"
        using evals_finals_same[OF _ vals] map_Val_eq by auto
      have D: "D = D'" and pns: "pns = pns'" and body: "body = body'"
        using sees_method_fun[OF SCallInitRed.hyps(1) method] by auto
      then have i: "i = Processing" using iDP shD s1 s1a nDone by simp
      then have s2: "(h2, l2, sh2) = s1" using D init' init_ProcessingE s1 s1a shD by blast
      then show ?thesis
        using eval_finalId SCallInit[OF eval_finalsId[of "map Val vs" P "(h,l,sh)"]
          SCallInitRed.hyps(1)] init init' len bstep nDone D pns body s' s1 s1a shD vals vs
          SCallInitRed.hyps(2-3) s2 by auto
    next
      fix vsa h2 l2 sh2 Ts T pns' body' D' sfs h3 l3 sh3
      assume s': "s' = (h3, l2, sh3)" and vals: "P  map Val vs,s1 [⇒] map Val vsa,(h2, l2, sh2)"
         and method: "P  C sees M, Static :  TsT = (pns', body') in D'"
         and "sh2 D' = (sfs, Done)  M = clinit  sh2 D' = (sfs, Processing)"
         and len: "length vsa = length pns'"
         and bstep: "P  body',(h2, [pns' [↦] vsa], sh2)  e',(h3, l3, sh3)"
      have vs: "vs = vsa" and s1a: "s1 = (h2, l2, sh2)"
        using evals_finals_same[OF _ vals] map_Val_eq by auto
      have D: "D = D'" and pns: "pns = pns'" and body: "body = body'"
        using sees_method_fun[OF SCallInitRed.hyps(1) method] by auto
      then show ?thesis using SCallInit[OF eval_finalsId[of "map Val vs" P "(h,l,sh)"]
        SCallInitRed.hyps(1)] bstep SCallInitRed.hyps(2-3) len s' s1a vals vs init by auto
    qed
  next
    fix e assume e': "e' = throw e"
     and init: "P  INIT D ([D],False)  unit,(h, l, sh)  throw e,s'"
    obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
    then obtain sfs i where shC: "sh' D = (sfs, i)" and iDP: "i = Error"
      using init_throw_PD[OF init] by auto
    then show ?thesis using SCallInitRed.hyps(2-3) init e'
      SCallInitThrow[OF eval_finalsId[of "map Val vs" _] SCallInitRed.hyps(1)]
     by auto
  qed
next
  case (RedSCallNone C M vs s b)
  then have tes: "THROW NoSuchMethodError = e'  s = s'"
    using eval_final_same by simp
  have "P  map Val vs,s [⇒] map Val vs,s" using eval_finalsId by simp
  then show ?case using RedSCallNone eval_evals.SCallNone tes by auto
next
  case (RedSCallNonStatic C M Ts T m D vs s b)
  then have tes: "THROW IncompatibleClassChangeError = e'  s = s'"
    using eval_final_same by simp
  have "P  map Val vs,s [⇒] map Val vs,s" using eval_finalsId by simp
  then show ?case using RedSCallNonStatic eval_evals.SCallNonStatic tes by auto
next
  case InitBlockRed
  thus ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros eval_finalId
                  simp: assigned_def map_upd_triv fun_upd_same)
next
  case (RedInitBlock V T v u s b)
  then have "P  Val u,s  e',s'" by simp
  then obtain s': "s'=s" and e': "e'=Val u" by cases simp
  obtain h l sh where s: "s=(h,l,sh)" by (cases s)
  have "P  {V:T :=Val v; Val u},(h,l,sh)  Val u,(h, (l(Vv))(V:=l V), sh)"
    by (fastforce intro!: eval_evals.intros)
  then have "P  {V:T := Val v; Val u},s  e',s'" using s s' e' by simp
  then show ?case by simp
next
  case BlockRedNone
  thus ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros 
                 simp add: fun_upd_same fun_upd_idem)
next
  case BlockRedSome
  thus ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros 
                 simp add:  fun_upd_same fun_upd_idem)
next
 case (RedBlock V T v s b) 
 then have "P  Val v,s  e',s'" by simp
 then obtain s': "s'=s" and e': "e'=Val v" 
    by cases simp
  obtain h l sh where s: "s=(h,l,sh)" by (cases s)
 have "P  Val v,(h,l(V:=None),sh)  Val v,(h,l(V:=None),sh)" 
   by (rule eval_evals.intros)
 hence "P  {V:T;Val v},(h,l,sh)  Val v,(h,(l(V:=None))(V:=l V),sh)"
   by (rule eval_evals.Block)
 then have "P  {V:T; Val v},s  e',s'" using s s' e' by simp
 then show ?case by simp
next
  case (SeqRed e s b e1 s1 b1 e2) show ?case
  proof(cases "val_of e")
    case None show ?thesis
    proof(cases "lass_val_of e")
      case lNone:None
      then have bconf: "P,shp s b (e,b) " using SeqRed.prems(1) None by simp
      then show ?thesis using SeqRed using seq_ext by fastforce
    next
      case (Some p)
      obtain V' v' where p: "p = (V',v')" and e: "e = V':=Val v'"
        using lass_val_of_spec[OF Some] by(cases p, auto)
      obtain h l sh h' l' sh' where s: "s = (h,l,sh)" and s1: "s1 = (h',l',sh')" by(cases s, cases s1)
      then have red: "P  e,(h,l,sh),b  e1,(h',l',sh'),b1" using SeqRed.hyps(1) by simp
      then have s1': "e1 = unit  h' = h  l' = l(V'  v')  sh' = sh"
        using lass_val_of_red[OF Some red] p e by simp
      then have eval: "P  e,s  e1,s1" using e s s1 LAss Val by auto
      then show ?thesis
        by (metis SeqRed.prems(2) eval_final eval_final_same seq_ext)
    qed
  next
    case (Some a) then show ?thesis using SeqRed.hyps(1) val_no_step by blast
  qed
next
  case RedSeq
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case CondRed
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros simp: val_no_step) 
next
  case RedCondT
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedCondF
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedWhile
  thus ?case
    by (auto simp add: unfold_while intro:eval_evals.intros elim:eval_cases)
next
  case ThrowRed then show ?case by(fastforce elim: eval_cases simp: eval_evals.intros)
next
  case RedThrowNull
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case TryRed thus ?case
    by(fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedTryCatch
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case (RedTryFail s a D fs C V e2 b)
  thus ?case
    by (cases s)(auto elim!: eval_cases intro: eval_evals.intros)
next
  case ListRed1
  thus ?case
    by (fastforce elim: evals_cases intro: eval_evals.intros simp: val_no_step)
next
  case ListRed2
  thus ?case
    by (fastforce elim!: evals_cases eval_cases 
                 intro: eval_evals.intros eval_finalId)
next
  case (RedInit e1 C b s1 b') then show ?case using InitFinal by simp
next
  case (InitNoneRed sh C C' Cs e h l b)
  show ?case using InitNone InitNoneRed.hyps InitNoneRed.prems(2) by auto
next
  case (RedInitDone sh C sfs C' Cs e h l b)
  show ?case using InitDone RedInitDone.hyps RedInitDone.prems(2) by auto
next
  case (RedInitProcessing sh C sfs C' Cs e h l b)
  show ?case using InitProcessing RedInitProcessing.hyps RedInitProcessing.prems(2) by auto
next
  case (RedInitError sh C sfs C' Cs e h l b)
  show ?case using InitError RedInitError.hyps RedInitError.prems(2) by auto
next
  case (InitObjectRed sh C sfs sh' C' Cs e h l b) show ?case using InitObject InitObjectRed by auto
next
  case (InitNonObjectSuperRed sh C sfs D r sh' C' Cs e h l b)
  show ?case using InitNonObject InitNonObjectSuperRed by auto
next
  case (RedInitRInit C' C Cs e h l sh b)
  show ?case using InitRInit RedInitRInit by auto
next
  case (RInitRed e s b e'' s'' b'' C Cs e0)
  then have IH: "e' s'. P  e'',s''  e',s'  P  e,s  e',s'" by simp
  show ?case using RInitRed rinit_ext[OF IH] by simp
next
  case (RedRInit sh C sfs i sh' C' Cs v e h l b s' e')
  then have init: "P  (INIT C' (Cs,True)  e), (h, l, sh(C  (sfs, Done)))  e',s'"
    using RedRInit by simp
  then show ?case using RInit RedRInit.hyps(1) RedRInit.hyps(3) Val by fastforce
next
  case BinOpThrow2
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case FAssThrow2
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case SFAssThrow
  then show ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case (CallThrowParams es vs e es' v M s b)
  have val: "P  Val v,s  Val v,s" by (rule eval_evals.intros)
  have eval_e: "P  throw (e),s  e',s'" using CallThrowParams by simp
  then obtain xa where e': "e' = Throw xa" by (cases) (auto dest!: eval_final)
  with list_eval_Throw [OF eval_e]
  have vals: "P  es,s [⇒] map Val vs @ Throw xa # es',s'"
    using CallThrowParams.hyps(1) eval_e list_eval_Throw by blast
  then have "P  Val vM(es),s  Throw xa,s'"
   using eval_evals.CallParamsThrow[OF val vals] by simp
  thus ?case using e' by simp
next
  case (SCallThrowParams es vs e es' C M s b)
  have eval_e: "P  throw (e),s  e',s'" using SCallThrowParams by simp
  then obtain xa where e': "e' = Throw xa" by (cases) (auto dest!: eval_final)
  then have "P  es,s [⇒] map Val vs @ Throw xa # es',s'"
    using SCallThrowParams.hyps(1) eval_e list_eval_Throw by blast
  then have "P  CsM(es),s  Throw xa,s'"
    by (rule eval_evals.SCallParamsThrow)
  thus ?case using e' by simp
next
  case (BlockThrow V T a s b)
  then have "P  Throw a, s  e',s'" by simp
  then obtain s': "s' = s" and e': "e' = Throw a"
    by cases (auto elim!:eval_cases)
  obtain h l sh where s: "s=(h,l,sh)" by (cases s)
  have "P  Throw a, (h,l(V:=None),sh)  Throw a, (h,l(V:=None),sh)"
    by (simp add:eval_evals.intros eval_finalId)
  hence "P{V:T;Throw a},(h,l,sh)  Throw a, (h,(l(V:=None))(V:=l V),sh)"
    by (rule eval_evals.Block)
  then have "P  {V:T; Throw a},s  e',s'" using s s' e' by simp
  then show ?case by simp
next
  case (InitBlockThrow V T v a s b)
  then have "P  Throw a,s  e',s'" by simp
  then obtain s': "s' = s" and e': "e' = Throw a"
    by cases (auto elim!:eval_cases)
  obtain h l sh where s: "s = (h,l,sh)" by (cases s)
  have "P  {V:T :=Val v; Throw a},(h,l,sh)  Throw a, (h, (l(Vv))(V:=l V),sh)"
    by(fastforce intro:eval_evals.intros)
  then have "P  {V:T := Val v; Throw a},s  e',s'" using s s' e' by simp
  then show ?case by simp
next
  case (RInitInitThrow sh C sfs i sh' a D Cs e h l b)
  have IH: "e' s'. P  RI (D,Throw a) ; Cs  e,(h, l, sh(C  (sfs, Error)))  e',s' 
    P  RI (C,Throw a) ; D # Cs  e,(h, l, sh)  e',s'"
    using RInitInitFail[OF eval_finalId] RInitInitThrow by simp
  then show ?case using RInitInitThrow.hyps(2) RInitInitThrow.prems(2) by auto
next
  case (RInitThrow sh C sfs i sh' a e h l b)
  then have e': "e' = Throw a" and s': "s' = (h,l,sh')"
    using eval_final_same final_def by fastforce+
  show ?case using RInitFailFinal RInitThrow.hyps(1) RInitThrow.hyps(2) e' eval_finalId s' by auto
qed(auto elim: eval_cases simp: eval_evals.intros)
(*>*)

(*<*)
(* ... und wieder anschalten: *)
declare split_paired_All [simp] split_paired_Ex [simp]
(*>*)

text ‹ Its extension to @{text"→*"}: › 

lemma extend_eval:
assumes wf: "wwf_J_prog P"
and reds: "P  e,s,b →* e'',s'',b''" and eval_rest:  "P  e'',s''  e',s'"
and iconf: "iconf (shp s) e" and bconf: "P,shp s b (e::expr,b) "
shows "P  e,s  e',s'"
(*<*)
using reds eval_rest iconf bconf
proof (induct rule: converse_rtrancl_induct3)
  case refl then show ?case by simp
next
  case (step e1 s1 b1 e2 s2 b2)
  then have ic: "iconf (shp s2) e2" using Red_preserves_iconf local.wf by blast
  then have ec: "P,shp s2 b (e2,b2) "
    using Red_preserves_bconf local.wf step.hyps(1) step.prems(2) step.prems(3) by blast
  show ?case using step ic ec extend_1_eval[OF wf step.hyps(1)] by simp
qed
(*>*)


lemma extend_evals:
assumes wf: "wwf_J_prog P"
and reds: "P  es,s,b [→]* es'',s'',b''" and eval_rest:  "P  es'',s'' [⇒] es',s'"
and iconf: "iconfs (shp s) es" and bconf: "P,shp s b (es::expr list,b) "
shows "P  es,s [⇒] es',s'"
(*<*)
using reds eval_rest iconf bconf
proof (induct rule: converse_rtrancl_induct3)
  case refl then show ?case by simp
next
  case (step es1 s1 b1 es2 s2 b2)
  then have ic: "iconfs (shp s2) es2" using Reds_preserves_iconf local.wf by blast
  then have ec: "P,shp s2 b (es2,b2) "
    using Reds_preserves_bconf local.wf step.hyps(1) step.prems(2) step.prems(3) by blast
  show ?case using step ic ec extend_1_evals[OF wf step.hyps(1)] by simp
qed
(*>*)

text ‹ Finally, small step semantics can be simulated by big step semantics:
›

theorem
assumes wf: "wwf_J_prog P"
shows small_by_big:
 "P  e,s,b →* e',s',b'; iconf (shp s) e; P,shp s b (e,b) ; final e'
    P  e,s  e',s'"
and "P  es,s,b [→]* es',s',b'; iconfs (shp s) es; P,shp s b (es,b) ; finals es'
    P  es,s [⇒] es',s'"
(*<*)
proof -
  note wf 
  moreover assume "P  e,s,b →* e',s',b'"
  moreover assume "final e'"
  then have "P  e',s'  e',s'"
    by (simp add: eval_finalId)
  moreover assume "iconf (shp s) e"
  moreover assume "P,shp s b (e,b) "
  ultimately show "P  e,s  e',s'"
    by (rule extend_eval)
next
  assume fins: "finals es'"
  note wf 
  moreover assume "P  es,s,b [→]* es',s',b'"
  moreover have "P  es',s' [⇒] es',s'" using fins
    by (rule eval_finalsId)
  moreover assume "iconfs (shp s) es"
  moreover assume "P,shp s b (es,b) "
  ultimately show "P  es,s [⇒] es',s'"
    by (rule extend_evals)
qed
(*>*)

subsection "Equivalence"

text‹ And now, the crowning achievement: ›

corollary big_iff_small:
" wwf_J_prog P; iconf (shp s) e; P,shp s b (e::expr,b)  
   P  e,s  e',s'  =  (P  e,s,b →* e',s',False  final e')"
(*<*)by(blast dest: big_by_small eval_final small_by_big)(*>*)

corollary big_iff_small_WT:
  "wwf_J_prog P  P,E  e::T  P,shp s b (e,b)  
  P  e,s  e',s'  =  (P  e,s,b →* e',s',False  final e')"
(*<*)by(blast dest: big_iff_small WT_nsub_RI nsub_RI_iconf)(*>*)


subsection ‹ Lifting type safety to @{text"⇒"}

text‹ \dots and now to the big step semantics, just for fun. ›

lemma eval_preserves_sconf:
fixes s::state and s'::state
assumes  "wf_J_prog P" and "P  e,s  e',s'" and "iconf (shp s) e"
 and "P,E  e::T" and "P,E  s"
shows "P,E  s'"
(*<*)
proof -
  have "P,shp s b (e,False) " by(simp add: bconf_def)
  with assms show ?thesis
    by(blast intro:Red_preserves_sconf Red_preserves_iconf Red_preserves_bconf big_by_small
                   WT_implies_WTrt wf_prog_wwf_prog)
qed
(*>*)


lemma eval_preserves_type:
fixes s::state
assumes wf: "wf_J_prog P"
 and "P  e,s  e',s'" and "P,E  s" and "iconf (shp s) e" and "P,E  e::T"
shows "T'. P  T'  T  P,E,hp s',shp s'  e':T'"
(*<*)
proof -
  have "P,shp s b (e,False) " by(simp add: bconf_def)
  with assms show ?thesis by(blast dest:big_by_small[OF wf_prog_wwf_prog[OF wf]]
                                        WT_implies_WTrt Red_preserves_type[OF wf])
qed
(*>*)


end

Theory Annotate

(*  Title:      JinjaDCI/J/Annotate.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/Annotate.thy by Tobias Nipkow
*)

section ‹ Program annotation ›

theory Annotate imports WellType begin

(*<*)
abbreviation (output)
  unanFAcc :: "expr  vname  expr" ("(__)" [10,10] 90) where
  "unanFAcc e F == FAcc e F []"

abbreviation (output)
  unanFAss :: "expr  vname  expr  expr" ("(__ := _)" [10,0,90] 90) where
  "unanFAss e F e' == FAss e F [] e'"
(*>*)

inductive
  Anno :: "[J_prog,env, expr     , expr]  bool"
         ("_,_  _  _"   [51,0,0,51]50)
  and Annos :: "[J_prog,env, expr list, expr list]  bool"
         ("_,_  _ [↝] _" [51,0,0,51]50)
  for P :: J_prog
where
  
  AnnoNew: "P,E  new C  new C"
| AnnoCast: "P,E  e  e'  P,E  Cast C e  Cast C e'"
| AnnoVal: "P,E  Val v  Val v"
| AnnoVarVar: "E V = T  P,E  Var V  Var V"
| AnnoVarField: " E V = None; E this = Class C; P  C sees V,NonStatic:T in D 
                P,E  Var V  Var thisV{D}"
| AnnoBinOp:
  " P,E  e1  e1';  P,E  e2  e2' 
    P,E  e1 «bop» e2  e1' «bop» e2'"
| AnnoLAssVar:
  " E V = T; P,E  e  e'   P,E  V:=e  V:=e'"
| AnnoLAssField:
  " E V = None; E this = Class C; P  C sees V,NonStatic:T in D; P,E  e  e' 
    P,E  V:=e  Var thisV{D} := e'"
| AnnoFAcc:
  " P,E  e  e';  P,E  e' :: Class C;  P  C sees F,NonStatic:T in D 
    P,E  eF{[]}  e'F{D}"
| AnnoSFAcc:
  " P  C sees F,Static:T in D 
    P,E  CsF{[]}  CsF{D}"
| AnnoFAss: " P,E  e1  e1';  P,E  e2  e2';
             P,E  e1' :: Class C; P  C sees F,NonStatic:T in D 
           P,E  e1F{[]} := e2  e1'F{D} := e2'"
| AnnoSFAss: " P,E  e2  e2'; P  C sees F,Static:T in D 
           P,E  CsF{[]} := e2  CsF{D} := e2'"
| AnnoCall:
  " P,E  e  e';  P,E  es [↝] es' 
    P,E  Call e M es  Call e' M es'"
| AnnoSCall:
  " P,E  es [↝] es' 
    P,E  SCall C M es  SCall C M es'"
| AnnoBlock:
  "P,E(V  T)  e  e'    P,E  {V:T; e}  {V:T; e'}"
| AnnoComp: " P,E  e1  e1';  P,E  e2  e2' 
             P,E  e1;;e2  e1';;e2'"
| AnnoCond: " P,E  e  e'; P,E  e1  e1';  P,E  e2  e2' 
           P,E  if (e) e1 else e2  if (e') e1' else e2'"
| AnnoLoop: " P,E  e  e';  P,E  c  c' 
           P,E  while (e) c  while (e') c'"
| AnnoThrow: "P,E  e  e'    P,E  throw e  throw e'"
| AnnoTry: " P,E  e1  e1';  P,E(V  Class C)  e2  e2' 
          P,E  try e1 catch(C V) e2  try e1' catch(C V) e2'"

| AnnoNil: "P,E  [] [↝] []"
| AnnoCons: " P,E  e  e';  P,E  es [↝] es' 
             P,E  e#es [↝] e'#es'"

end

Theory JVMState

(*  Title:      Jinja/JVM/JVMState.thy

    Author:     Cornelia Pusch, Gerwin Klein, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory JVM/JVMState.thy by Cornelia Pusch and Gerwin Klein
*)

chapter ‹ Jinja Virtual Machine \label{cha:jvm} ›

section ‹ State of the JVM ›

theory JVMState imports "../Common/Objects" begin


type_synonym 
  pc = nat

abbreviation start_sheap :: "sheap"
where "start_sheap  (λx. None)(Start  (Map.empty,Done))"

definition start_sheap_preloaded :: "'m prog  sheap"
where
  "start_sheap_preloaded P  fold (λ(C,cl) f. f(C := Some (sblank P C, Prepared))) P (λx. None)"

subsection ‹ Frame Stack ›

datatype init_call_status = No_ics | Calling cname "cname list"
                          | Called "cname list" | Throwing "cname list" addr
	― ‹@{text "No_ics"} = not currently calling or waiting for the result of an initialization procedure call›
  ― ‹@{text "Calling C Cs"} = current instruction is calling for initialization of classes @{text "C#Cs"} (last class
      is the original) -- still collecting classes to be initialized, @{text "C"} most recently collected›
  ― ‹@{text "Called Cs"} = current instruction called initialization and is waiting for the result
      -- now initializing classes in the list›
  ― ‹@{text "Throwing Cs a"} = frame threw or was thrown an error causing erroneous end of initialization
        procedure for classes @{text "Cs"}

type_synonym
  frame = "val list × val list × cname × mname × pc × init_call_status"
  ― ‹operand stack› 
  ― ‹registers (including this pointer, method parameters, and local variables)›
  ― ‹name of class where current method is defined›
  ― ‹current method›
  ― ‹program counter within frame›
  ― ‹indicates frame's initialization call status›

translations
  (type) "frame" <= (type) "val list × val list × char list × char list × nat × init_call_status"

fun curr_stk :: "frame  val list" where
"curr_stk (stk, loc, C, M, pc, ics) = stk"

fun curr_class :: "frame  cname" where
"curr_class (stk, loc, C, M, pc, ics) = C"

fun curr_method :: "frame  mname" where
"curr_method (stk, loc, C, M, pc, ics) = M"

fun curr_pc :: "frame  nat" where
"curr_pc (stk, loc, C, M, pc, ics) = pc"

fun init_status :: "frame  init_call_status" where
 "init_status (stk, loc, C, M, pc, ics) = ics"

fun ics_of :: "frame  init_call_status" where
 "ics_of fr = snd(snd(snd(snd(snd fr))))"


subsection ‹ Runtime State ›

type_synonym
  jvm_state = "addr option × heap × frame list × sheap"  
  ― ‹exception flag, heap, frames, static heap›

translations
  (type) "jvm_state" <= (type) "nat option × heap × frame list × sheap"

fun frames_of :: "jvm_state  frame list" where
"frames_of (xp, h, frs, sh) = frs"

abbreviation sheap :: "jvm_state  sheap" where
"sheap js  snd (snd (snd js))"

end

Theory JVMInstructions

(*  Title:      JinjaDCI/JVM/JVMInstructions.thy

    Author:     Gerwin Klein, Susannah Mansky
    Copyright   2000 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory JVM/JVMInstructions.thy by Gerwin Klein
*)

section ‹ Instructions of the JVM ›


theory JVMInstructions imports JVMState begin


datatype 
  instr = Load nat                  ― ‹load from local variable›
        | Store nat                 ― ‹store into local variable›
        | Push val                  ― ‹push a value (constant)›
        | New cname                 ― ‹create object›
        | Getfield vname cname      ― ‹Fetch field from object›
        | Getstatic cname vname cname     ― ‹Fetch static field from class›
        | Putfield vname cname      ― ‹Set field in object    ›
        | Putstatic cname vname cname     ― ‹Set static field in class›
        | Checkcast cname           ― ‹Check whether object is of given type›
        | Invoke mname nat          ― ‹inv. instance meth of an object›
        | Invokestatic cname mname nat    ― ‹inv. static method of a class›
        | Return                    ― ‹return from method›
        | Pop                       ― ‹pop top element from opstack›
        | IAdd                      ― ‹integer addition›
        | Goto int                  ― ‹goto relative address›
        | CmpEq                     ― ‹equality comparison›
        | IfFalse int               ― ‹branch if top of stack false›
        | Throw                     ― ‹throw top of stack as exception›

type_synonym
  bytecode = "instr list"

type_synonym
  ex_entry = "pc × pc × cname × pc × nat" 
  ― ‹start-pc, end-pc, exception type, handler-pc, remaining stack depth›

type_synonym
  ex_table = "ex_entry list"

type_synonym
  jvm_method = "nat × nat × bytecode × ex_table"
   ― ‹max stacksize›
   ― ‹number of local variables. Add 1 + no. of parameters to get no. of registers›
   ― ‹instruction sequence›
   ― ‹exception handler table›

type_synonym
  jvm_prog = "jvm_method prog"

(*<*)
translations
  (type) "bytecode" <= (type) "instr list"
  (type) "ex_entry" <= (type) "nat × nat × char list × nat × nat"
  (type) "ex_table" <= (type) "ex_entry list"
  (type) "jvm_method"   <= (type) "nat × nat × bytecode × ex_table"
  (type) "jvm_prog" <= (type) "jvm_method prog"
(*>*)

end

Theory JVMExceptions

(*  Title:      JinjaDCI/JVM/JVMExceptions.thy
    Author:     Gerwin Klein, Martin Strecker, Susannah Mansky
    Copyright   2001 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory JVM/JVMExceptions.thy by Gerwin Klein and Martin Strecker
*)

section ‹ Exception handling in the JVM ›

theory JVMExceptions imports "../Common/Exceptions" JVMInstructions
begin

definition matches_ex_entry :: "'m prog  cname  pc  ex_entry  bool"
where
  "matches_ex_entry P C pc xcp 
                 let (s, e, C', h, d) = xcp in
                 s  pc  pc < e  P  C * C'"


primrec match_ex_table :: "'m prog  cname  pc  ex_table  (pc × nat) option"
where
  "match_ex_table P C pc []     = None"
| "match_ex_table P C pc (e#es) = (if matches_ex_entry P C pc e
                                   then Some (snd(snd(snd e)))
                                   else match_ex_table P C pc es)"

abbreviation
  ex_table_of :: "jvm_prog  cname  mname  ex_table" where
  "ex_table_of P C M == snd (snd (snd (snd (snd (snd (snd (method P C M)))))))"


fun find_handler :: "jvm_prog  addr  heap  frame list  sheap  jvm_state"
where
  "find_handler P a h [] sh = (Some a, h, [], sh)"
| "find_handler P a h (fr#frs) sh = 
       (let (stk,loc,C,M,pc,ics) = fr in
         case match_ex_table P (cname_of h a) pc (ex_table_of P C M) of
           None  
              (case M = clinit of
                 True  (case frs of (stk',loc',C',M',pc',ics')#frs'
                                   (case ics' of Called Cs  (None, h, (stk',loc',C',M',pc',Throwing (C#Cs) a)#frs', sh)
                                                 | _  (None, h, (stk',loc',C',M',pc',ics')#frs', sh) ― ‹this won't happen in wf code›
                                     )
                              | []  (Some a, h, [], sh)
                    )
               | _  find_handler P a h frs sh
              )
         | Some pc_d  (None, h, (Addr a # drop (size stk - snd pc_d) stk, loc, C, M, fst pc_d, No_ics)#frs, sh))"

lemma find_handler_cases:
 "find_handler P a h frs sh = js
   (frs'. frs'  []  js = (None, h, frs', sh))  (js = (Some a, h, [], sh))"
proof(induct P a h frs sh rule: find_handler.induct)
  case 1 then show ?case by clarsimp
next
  case (2 P a h fr frs sh) then show ?case
    by(cases fr, auto split: bool.splits list.splits init_call_status.splits)
qed

lemma find_handler_heap[simp]:
"find_handler P a h frs sh = (xp',h',frs',sh')  h' = h"
 by(auto dest: find_handler_cases)

lemma find_handler_sheap[simp]:
"find_handler P a h frs sh = (xp',h',frs',sh')  sh' = sh"
 by(auto dest: find_handler_cases)

lemma find_handler_frames[simp]:
"find_handler P a h frs sh = (xp',h',frs',sh')  length frs'  length frs"
proof(induct frs)
  case Nil then show ?case by simp
next
  case (Cons a frs) then show ?case
    by(auto simp: split_beta split: bool.splits list.splits init_call_status.splits)
qed

lemma find_handler_None:
 "find_handler P a h frs sh = (None, h, frs', sh')  frs'  []"
 by (drule find_handler_cases, clarsimp)

lemma find_handler_Some:
 "find_handler P a h frs sh = (Some x, h, frs', sh')  frs' = []"
 by (drule find_handler_cases, clarsimp)

lemma find_handler_Some_same_error_same_heap[simp]:
 "find_handler P a h frs sh = (Some x, h', frs', sh')  x = a  h = h'  sh = sh'"
 by(auto dest: find_handler_cases)

lemma find_handler_prealloc_pres:
assumes "preallocated h"
and fh: "find_handler P a h frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
using assms find_handler_heap[OF fh] by simp

lemma find_handler_frs_tl_neq:
 "ics_of f  No_ics
   (xp, h, f#frs, sh)  find_handler P xa h' (f' # frs) sh'"
proof(induct frs arbitrary: f f')
  case Nil then show ?case by(auto simp: split_beta split: bool.splits)
next
  case (Cons a frs)
  obtain xp1 h1 frs1 sh1 where fh: "find_handler P xa h' (a # frs) sh' = (xp1,h1,frs1,sh1)"
   by(cases "find_handler P xa h' (a # frs) sh'")
  then have "length frs1  length (a#frs)"
    by(rule find_handler_frames[where P=P and a=xa and h=h' and frs="a#frs" and sh=sh'])
  then have neq: "f#a#frs  frs1" by(clarsimp dest: impossible_Cons)
  then show ?case
  proof(cases "find_handler P xa h' (f' # a # frs) sh' = find_handler P xa h' (a # frs) sh'")
    case True then show ?thesis using neq fh by simp
  next
    case False then show ?thesis using Cons.prems
      by(fastforce simp: split_beta split: bool.splits init_call_status.splits list.splits)
  qed
qed

end

Theory JVMExecInstr

(*  Title:      JinjaDCI/JVM/JVMExecInstr.thy
    Author: Cornelia Pusch, Gerwin Klein, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen

    Based on the Jinja theory JVM/JVMExecInstr.thy by Cornelia Pusch and Gerwin Klein
*)

section ‹ Program Execution in the JVM ›

theory JVMExecInstr
imports JVMInstructions JVMExceptions
begin

 ― ‹ frame calling the class initialization method for the given class
 in the given program ›
fun create_init_frame :: "[jvm_prog, cname]  frame" where
"create_init_frame P C =
  (let (D,b,Ts,T,(mxs,mxl0,ins,xt)) = method P C clinit
   in ([],(replicate mxl0 undefined),D,clinit,0,No_ics)
  )"

primrec exec_instr :: "[instr, jvm_prog, heap, val list, val list,
                  cname, mname, pc, init_call_status, frame list, sheap]  jvm_state"
where
  exec_instr_Load:
"exec_instr (Load n) P h stk loc C0 M0 pc ics frs sh =
   (None, h, ((loc ! n) # stk, loc, C0, M0, Suc pc, ics)#frs, sh)"

| exec_instr_Store:
"exec_instr (Store n) P h stk loc C0 M0 pc ics frs sh =
   (None, h, (tl stk, loc[n:=hd stk], C0, M0, Suc pc, ics)#frs, sh)"

| exec_instr_Push:
"exec_instr (Push v) P h stk loc C0 M0 pc ics frs sh =
   (None, h, (v # stk, loc, C0, M0, Suc pc, ics)#frs, sh)"

|  exec_instr_New:
"exec_instr (New C) P h stk loc C0 M0 pc ics frs sh =
   (case (ics, sh C) of
          (Called Cs, _) 
            (case new_Addr h of
                  None  (addr_of_sys_xcpt OutOfMemory, h, (stk, loc, C0, M0, pc, No_ics)#frs, sh)
                | Some a  (None, h(ablank P C), (Addr a#stk, loc, C0, M0, Suc pc, No_ics)#frs, sh)
            )
        | (_, Some(obj, Done)) 
            (case new_Addr h of
                  None  (addr_of_sys_xcpt OutOfMemory, h, (stk, loc, C0, M0, pc, ics)#frs, sh)
                | Some a  (None, h(ablank P C), (Addr a#stk, loc, C0, M0, Suc pc, ics)#frs, sh)
            )
        | _  (None, h, (stk, loc, C0, M0, pc, Calling C [])#frs, sh)
   )"

| exec_instr_Getfield:
"exec_instr (Getfield F C) P h stk loc C0 M0 pc ics frs sh =
  (let v      = hd stk;
       (D,fs) = the(h(the_Addr v));
       (D',b,t) = field P C F;
       xp'    = if v=Null then addr_of_sys_xcpt NullPointer
                else if ¬(t b. P  D has F,b:t in C)
                     then addr_of_sys_xcpt NoSuchFieldError
                     else case b of Static  addr_of_sys_xcpt IncompatibleClassChangeError
                                  | NonStatic  None
   in case xp' of None  (xp', h, (the(fs(F,C))#(tl stk), loc, C0, M0, pc+1, ics)#frs, sh)
                | Some x  (xp', h, (stk, loc, C0, M0, pc, ics)#frs, sh))"

| exec_instr_Getstatic:
"exec_instr (Getstatic C F D) P h stk loc C0 M0 pc ics frs sh =
  (let (D',b,t) = field P D F;
       xp'    = if ¬(t b. P  C has F,b:t in D)
                then addr_of_sys_xcpt NoSuchFieldError
                else case b of NonStatic  addr_of_sys_xcpt IncompatibleClassChangeError
                             | Static  None
   in (case (xp', ics, sh D') of
            (Some a, _)  (xp', h, (stk, loc, C0, M0, pc, ics)#frs, sh)
          | (_, Called Cs, _)  let (sfs, i) = the(sh D');
                                       v = the(sfs F)
                                    in (xp', h, (v#stk, loc, C0, M0, Suc pc, No_ics)#frs, sh)
          | (_, _, Some (sfs, Done))  let v = the (sfs F)
                                        in (xp', h, (v#stk, loc, C0, M0, Suc pc, ics)#frs, sh)
          | _  (xp', h, (stk, loc, C0, M0, pc, Calling D' [])#frs, sh)
      )
  )"

| exec_instr_Putfield:
"exec_instr (Putfield F C) P h stk loc C0 M0 pc ics frs sh =
  (let v    = hd stk;
       r    = hd (tl stk);
       a    = the_Addr r;
       (D,fs) = the (h a);
       (D',b,t) = field P C F;
       xp'    = if r=Null then addr_of_sys_xcpt NullPointer
                else if ¬(t b. P  D has F,b:t in C)
                     then addr_of_sys_xcpt NoSuchFieldError
                     else case b of Static  addr_of_sys_xcpt IncompatibleClassChangeError
                                  | NonStatic  None;
       h'  = h(a  (D, fs((F,C)  v)))
   in case xp' of None  (xp', h', (tl (tl stk), loc, C0, M0, pc+1, ics)#frs, sh)
                | Some x  (xp', h, (stk, loc, C0, M0, pc, ics)#frs, sh)
  )"

| exec_instr_Putstatic:
"exec_instr (Putstatic C F D) P h stk loc C0 M0 pc ics frs sh =
  (let (D',b,t) = field P D F;
       xp'    = if ¬(t b. P  C has F,b:t in D)
                then addr_of_sys_xcpt NoSuchFieldError
                else case b of NonStatic  addr_of_sys_xcpt IncompatibleClassChangeError
                             | Static  None
   in (case (xp', ics, sh D') of
            (Some a, _)  (xp', h, (stk, loc, C0, M0, pc, ics)#frs, sh)
          | (_, Called Cs, _)
        let (sfs, i) = the(sh D')
          in (xp', h, (tl stk, loc, C0, M0, Suc pc, No_ics)#frs, sh(D':=Some ((sfs(F  hd stk)), i)))
          | (_, _, Some (sfs, Done))
        (xp', h, (tl stk, loc, C0, M0, Suc pc, ics)#frs, sh(D':=Some ((sfs(F  hd stk)), Done)))
          | _  (xp', h, (stk, loc, C0, M0, pc, Calling D' [])#frs, sh)
      )
  )"

| exec_instr_Checkcast:
"exec_instr (Checkcast C) P h stk loc C0 M0 pc ics frs sh =
   (if cast_ok P C h (hd stk)
     then (None, h, (stk, loc, C0, M0, Suc pc, ics)#frs, sh)
     else (addr_of_sys_xcpt ClassCast, h, (stk, loc, C0, M0, pc, ics)#frs, sh)
   )"

| exec_instr_Invoke:
"exec_instr (Invoke M n) P h stk loc C0 M0 pc ics frs sh =
  (let ps  = take n stk;
       r   = stk!n;
       C   = fst(the(h(the_Addr r)));
       (D,b,Ts,T,mxs,mxl0,ins,xt)= method P C M;
       xp' = if r=Null then addr_of_sys_xcpt NullPointer
             else if ¬(Ts T m D b. P  C sees M,b:Ts  T = m in D)
                  then addr_of_sys_xcpt NoSuchMethodError
                  else case b of Static  addr_of_sys_xcpt IncompatibleClassChangeError
                               | NonStatic  None;
       f'  = ([],[r]@(rev ps)@(replicate mxl0 undefined),D,M,0,No_ics)
   in case xp' of None  (xp', h, f'#(stk, loc, C0, M0, pc, ics)#frs, sh)
                | Some a  (xp', h, (stk, loc, C0, M0, pc, ics)#frs, sh)
  )"

| exec_instr_Invokestatic:
"exec_instr (Invokestatic C M n) P h stk loc C0 M0 pc ics frs sh =
  (let ps  = take n stk;
       (D,b,Ts,T,mxs,mxl0,ins,xt)= method P C M;
       xp' = if ¬(Ts T m D b. P  C sees M,b:Ts  T = m in D)
             then addr_of_sys_xcpt NoSuchMethodError
             else case b of NonStatic  addr_of_sys_xcpt IncompatibleClassChangeError
                          | Static  None;
       f'  = ([],(rev ps)@(replicate mxl0 undefined),D,M,0,No_ics)
   in (case (xp', ics, sh D) of
            (Some a, _)  (xp', h, (stk, loc, C0, M0, pc, ics)#frs, sh)
          | (_, Called Cs, _)  (xp', h, f'#(stk, loc, C0, M0, pc, No_ics)#frs, sh)
          | (_, _, Some (sfs, Done))  (xp', h, f'#(stk, loc, C0, M0, pc, ics)#frs, sh)
          | _  (xp', h, (stk, loc, C0, M0, pc, Calling D [])#frs, sh)
      )
  )"

| exec_instr_Return:
 "exec_instr Return P h stk0 loc0 C0 M0 pc ics frs sh =
    (case frs of
         []  let sh' =  (case M0 = clinit of True  sh(C0:=Some(fst(the(sh C0)), Done))
                                             | _  sh
                           )
                in (None, h, [], sh')
       | (stk',loc',C',m',pc',ics')#frs'
             let (D,b,Ts,T,(mxs,mxl0,ins,xt)) = method P C0 M0;
                   offset = case b of NonStatic  1 | Static  0;
                   (sh'', stk'', pc'') = (case M0 = clinit of True  (sh(C0:=Some(fst(the(sh C0)), Done)), stk', pc')
                                                | _  (sh, (hd stk0)#(drop (length Ts + offset) stk'), Suc pc')
                                        )
               in (None, h, (stk'',loc',C',m',pc'',ics')#frs', sh'')
    )"

| exec_instr_Pop:
"exec_instr Pop P h stk loc C0 M0 pc ics frs sh = (None, h, (tl stk, loc, C0, M0, Suc pc, ics)#frs, sh)"

| exec_instr_IAdd:
"exec_instr IAdd P h stk loc C0 M0 pc ics frs sh =
    (None, h, (Intg (the_Intg (hd (tl stk)) + the_Intg (hd stk))#(tl (tl stk)), loc, C0, M0, Suc pc, ics)#frs, sh)"

| exec_instr_IfFalse:
"exec_instr (IfFalse i) P h stk loc C0 M0 pc ics frs sh =
  (let pc' = if hd stk = Bool False then nat(int pc+i) else pc+1
   in (None, h, (tl stk, loc, C0, M0, pc', ics)#frs, sh))"

| exec_instr_CmpEq:
"exec_instr CmpEq P h stk loc C0 M0 pc ics frs sh =
    (None, h, (Bool (hd (tl stk) = hd stk) # tl (tl stk), loc, C0, M0, Suc pc, ics)#frs, sh)"

| exec_instr_Goto:
"exec_instr (Goto i) P h stk loc C0 M0 pc ics frs sh =
   (None, h, (stk, loc, C0, M0, nat(int pc+i), ics)#frs, sh)"

| exec_instr_Throw:
"exec_instr Throw P h stk loc C0 M0 pc ics frs sh =
  (let xp' = if hd stk = Null then addr_of_sys_xcpt NullPointer
             else the_Addr(hd stk)
   in (xp', h, (stk, loc, C0, M0, pc, ics)#frs, sh))"



text "Given a preallocated heap, a thrown exception is either a system exception or
   thrown directly by @{term Throw}."
lemma exec_instr_xcpts:
assumes "σ' = exec_instr i P h stk loc C M pc ics' frs sh"
  and "fst σ' = Some a"
shows "i = (JVMInstructions.Throw)  a  {a. x  sys_xcpts. a = addr_of_sys_xcpt x}"
using assms
proof(cases i)
  case (New C1) then show ?thesis using assms
  proof(cases "sh C1")
    case (Some a)
    then obtain sfs i where sfsi: "a = (sfs,i)" by(cases a)
    then show ?thesis using Some New assms
    proof(cases i) qed(cases ics', auto)+
  qed(cases ics', auto)
next
  case (Getfield F1 C1)
  obtain D' b t where field: "field P C1 F1 = (D',b,t)" by(cases "field P C1 F1")
  obtain D fs where addr: "the (h (the_Addr (hd stk))) = (D,fs)" by(cases "the (h (the_Addr (hd stk)))")
  show ?thesis using addr field Getfield assms
  proof(cases "hd stk = Null")
    case nNull:False then show ?thesis using addr field Getfield assms
    proof(cases "t b. P  (cname_of h (the_Addr (hd stk))) has F1,b:t in C1")
      case exists:False show ?thesis
      proof(cases "fst(snd(field P C1 F1))")
        case Static
        then show ?thesis using exists nNull addr field Getfield assms
         by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
      next
        case NonStatic
        then show ?thesis using exists nNull addr field Getfield assms
         by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
      qed
    qed(auto)
  qed(auto)
next
  case (Getstatic C1 F1 D1)
  obtain D' b t where field: "field P D1 F1 = (D',b,t)" by(cases "field P D1 F1")
  show ?thesis using field Getstatic assms
  proof(cases "t b. P  C1 has F1,b:t in D1")
    case exists:False then show ?thesis using field Getstatic assms
    proof(cases "fst(snd(field P D1 F1))")
      case Static
      then obtain sfs i where "the(sh D') = (sfs, i)" by(cases "the(sh D')")
      then show ?thesis using exists field Static Getstatic assms by(cases ics'; cases i, auto)
    qed(auto)
  qed(auto)
next
  case (Putfield F1 C1)
  let ?r = "hd(tl stk)"
  obtain D' b t where field: "field P C1 F1 = (D',b,t)" by(cases "field P C1 F1")
  obtain D fs where addr: "the (h (the_Addr ?r)) = (D,fs)"
    by(cases "the (h (the_Addr ?r))")
  show ?thesis using addr field Putfield assms
  proof(cases "?r = Null")
    case nNull:False then show ?thesis using addr field Putfield assms
    proof(cases "t b. P  (cname_of h (the_Addr ?r)) has F1,b:t in C1")
      case exists:False show ?thesis
      proof(cases b)
        case Static
        then show ?thesis using exists nNull addr field Putfield assms
         by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
      next
        case NonStatic
        then show ?thesis using exists nNull addr field Putfield assms
         by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
      qed
    qed(auto)
  qed(auto)
next
  case (Putstatic C1 F1 D1)
  obtain D' b t where field: "field P D1 F1 = (D',b,t)" by(cases "field P D1 F1")
  show ?thesis using field Putstatic assms
  proof(cases "t b. P  C1 has F1,b:t in D1")
    case exists:False then show ?thesis using field Putstatic assms
    proof(cases b)
      case Static
      then obtain sfs i where "the(sh D') = (sfs, i)" by(cases "the(sh D')")
      then show ?thesis using exists field Static Putstatic assms by(cases ics'; cases i, auto)
    qed(auto)
  qed(auto)
next
  case (Checkcast C1) then show ?thesis using assms by(cases "cast_ok P C1 h (hd stk)", auto)
next
  case (Invoke M n)
  let ?r = "stk!n"
  let ?C = "cname_of h (the_Addr ?r)"
  show ?thesis using Invoke assms
  proof(cases "?r = Null")
    case nNull:False then show ?thesis using Invoke assms
    proof(cases "¬(Ts T m D b. P  ?C sees M,b:Ts  T = m in D)")
      case exists:False then show ?thesis using nNull Invoke assms
      proof(cases "fst(snd(method P ?C M))")
        case Static
        then show ?thesis using exists nNull Invoke assms
         by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
      next
        case NonStatic
        then show ?thesis using exists nNull Invoke assms
         by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
      qed
    qed(auto)
  qed(auto)
next
  case (Invokestatic C1 M n)
  show ?thesis using Invokestatic assms
  proof(cases "¬(Ts T m D b. P  C1 sees M,b:Ts  T = m in D)")
    case exists:False then show ?thesis using Invokestatic assms
    proof(cases "fst(snd(method P C1 M))")
      case Static
      then obtain sfs i where "the(sh (fst(method P C1 M))) = (sfs, i)"
        by(cases "the(sh (fst(method P C1 M)))")
      then show ?thesis using exists Static Invokestatic assms
        by(auto split: init_call_status.splits init_state.splits)
    qed(auto)
  qed(auto)
next
  case Return then show ?thesis using assms
  proof(cases frs)
    case (Cons f frs') then show ?thesis using Return assms
      by(cases f, cases "method P C M", cases "M=clinit", auto)
  qed(auto)
next
  case (IfFalse x17) then show ?thesis using assms
  proof(cases "hd stk")
    case (Bool b) then show ?thesis using IfFalse assms by(cases b, auto)
  qed(auto)
qed(auto)

lemma exec_instr_prealloc_pres:
assumes "preallocated h"
  and "exec_instr i P h stk loc C0 M0 pc ics frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
using assms
proof(cases i)
  case (New C1)
  then obtain sfs i where sfsi: "the(sh C1) = (sfs,i)" by(cases "the(sh C1)")
  then show ?thesis using preallocated_new[of h] New assms
    by(cases "blank P C1", auto dest: new_Addr_SomeD split: init_call_status.splits init_state.splits)
next
  case (Getfield F1 C1) then show ?thesis using assms
    by(cases "the (h (the_Addr (hd stk)))", cases "field P C1 F1", auto)
next
  case (Getstatic C1 F1 D1)
  then obtain sfs i where sfsi: "the(sh (fst (field P D1 F1))) = (sfs, i)"
   by(cases "the(sh (fst (field P D1 F1)))")
  then show ?thesis using Getstatic assms
   by(cases "field P D1 F1", auto split: init_call_status.splits init_state.splits)
next
  case (Putfield F1 C1) then show ?thesis using preallocated_new preallocated_upd_obj assms
    by(cases "the (h (the_Addr (hd (tl stk))))", cases "field P C1 F1", auto, metis option.collapse)
next
  case (Putstatic C1 F1 D1)
  then obtain sfs i where sfsi: "the(sh (fst (field P D1 F1))) = (sfs, i)"
   by(cases "the(sh (fst (field P D1 F1)))")
  then show ?thesis using Putstatic assms
   by(cases "field P D1 F1", auto split: init_call_status.splits init_state.splits)
next
  case (Checkcast C1)
  then show ?thesis using assms
  proof(cases "hd stk = Null")
    case False then show ?thesis
     using Checkcast assms
       by(cases "P  cname_of h (the_Addr (hd stk)) * C1", auto simp: cast_ok_def)
  qed(simp add: cast_ok_def)
next
  case (Invoke M n)
  then show ?thesis using assms by(cases "method P (cname_of h (the_Addr (stk ! n))) M", auto)
next
  case (Invokestatic C1 M n)
  show ?thesis
  proof(cases "sh (fst (method P C1 M))")
    case None then show ?thesis using Invokestatic assms
     by(cases "method P C1 M", auto split: init_call_status.splits)
  next
    case (Some a)
    then obtain sfs i where sfsi: "a = (sfs, i)" by(cases a)
    then show ?thesis using Some Invokestatic assms
    proof(cases i) qed(cases "method P C1 M", auto split: init_call_status.splits)+
  qed
next
  case Return
  then show ?thesis using assms by(cases "method P C0 M0", auto simp: split_beta split: list.splits)
next
  case (IfFalse x17) then show ?thesis using assms by(auto split: val.splits bool.splits)
next
  case Throw then show ?thesis using assms by(auto split: val.splits)
qed(auto)

end

Theory JVMExec

(*  Title:      JinjaDCI/JVM/JVMExec.thy
    Author: Cornelia Pusch, Gerwin Klein, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20

    Based on the Jinja theory JVM/JVMExec.thy by Cornelia Pusch and Gerwin Klein
*)

section ‹ Program Execution in the JVM in full small step style ›

theory JVMExec
imports JVMExecInstr
begin

abbreviation
  instrs_of :: "jvm_prog  cname  mname  instr list" where
  "instrs_of P C M == fst(snd(snd(snd(snd(snd(snd(method P C M)))))))"

fun curr_instr :: "jvm_prog  frame  instr" where
"curr_instr P (stk,loc,C,M,pc,ics) = instrs_of P C M ! pc"

― ‹ execution of single step of the initialization procedure ›
fun exec_Calling :: "[cname, cname list, jvm_prog, heap, val list, val list,
                  cname, mname, pc, frame list, sheap]  jvm_state"
where
"exec_Calling C Cs P h stk loc C0 M0 pc frs sh =
  (case sh C of
        None  (None, h, (stk, loc, C0, M0, pc, Calling C Cs)#frs, sh(C := Some (sblank P C, Prepared)))
      | Some (obj, iflag) 
          (case iflag of
              Done  (None, h, (stk, loc, C0, M0, pc, Called Cs)#frs, sh)
            | Processing  (None, h, (stk, loc, C0, M0, pc, Called Cs)#frs, sh)
            | Error  (None, h, (stk, loc, C0, M0, pc,
                                   Throwing Cs (addr_of_sys_xcpt NoClassDefFoundError))#frs, sh)
            | Prepared 
                let sh' = sh(C:=Some(fst(the(sh C)), Processing));
                    D = fst(the(class P C))
                 in if C = Object
                    then (None, h, (stk, loc, C0, M0, pc, Called (C#Cs))#frs, sh')
                    else (None, h, (stk, loc, C0, M0, pc, Calling D (C#Cs))#frs, sh')
          )
  )"

― ‹ single step of execution without error handling ›
fun exec_step :: "[jvm_prog, heap, val list, val list,
                  cname, mname, pc, init_call_status, frame list, sheap]  jvm_state"
where
"exec_step P h stk loc C M pc (Calling C' Cs) frs sh
   = exec_Calling C' Cs P h stk loc C M pc frs sh" |
"exec_step P h stk loc C M pc (Called (C'#Cs)) frs sh
   = (None, h, create_init_frame P C'#(stk, loc, C, M, pc, Called Cs)#frs, sh)" |
"exec_step P h stk loc C M pc (Throwing (C'#Cs) a) frs sh
   = (None, h, (stk,loc,C,M,pc,Throwing Cs a)#frs, sh(C':=Some(fst(the(sh C')), Error)))" |
"exec_step P h stk loc C M pc (Throwing [] a) frs sh
   = (a, h, (stk,loc,C,M,pc,No_ics)#frs, sh)" |
"exec_step P h stk loc C M pc ics frs sh
   = exec_instr (instrs_of P C M ! pc) P h stk loc C M pc ics frs sh"

― ‹ execution including error handling ›
fun exec :: "jvm_prog × jvm_state  jvm_state option" ― ‹single step execution› where
"exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) =
   (let (xp', h', frs', sh') = exec_step P h stk loc C M pc ics frs sh
     in case xp' of
            None  Some (None,h',frs',sh')
          | Some x  Some (find_handler P x h ((stk,loc,C,M,pc,ics)#frs) sh)
   )"
| "exec _ = None"

― ‹relational view›
inductive_set
  exec_1 :: "jvm_prog  (jvm_state × jvm_state) set"
  and exec_1' :: "jvm_prog  jvm_state  jvm_state  bool" 
    ("_ / _ -jvm→1/ _" [61,61,61] 60)
  for P :: jvm_prog
where
  "P  σ -jvm→1 σ'  (σ,σ')  exec_1 P"
| exec_1I: "exec (P,σ) = Some σ'  P  σ -jvm→1 σ'"

― ‹reflexive transitive closure:›
definition exec_all :: "jvm_prog  jvm_state  jvm_state  bool"
    ("(_ / _ -jvm→/ _)" [61,61,61]60) where
  exec_all_def1: "P  σ -jvm→ σ'  (σ,σ')  (exec_1 P)*"

notation (ASCII)
  exec_all  ("_ |-/ _ -jvm->/ _" [61,61,61]60)


lemma exec_1_eq:
  "exec_1 P = {(σ,σ'). exec (P,σ) = Some σ'}"
(*<*)by (auto intro: exec_1I elim: exec_1.cases)(*>*)

lemma exec_1_iff:
  "P  σ -jvm→1 σ' = (exec (P,σ) = Some σ')"
(*<*)by (simp add: exec_1_eq)(*>*)

lemma exec_all_def:
  "P  σ -jvm→ σ' = ((σ,σ')  {(σ,σ'). exec (P,σ) = Some σ'}*)"
(*<*)by (simp add: exec_all_def1 exec_1_eq)(*>*)

lemma jvm_refl[iff]: "P  σ -jvm→ σ"
(*<*)by(simp add: exec_all_def)(*>*)

lemma jvm_trans[trans]:
 " P  σ -jvm→ σ'; P  σ' -jvm→ σ''   P  σ -jvm→ σ''"
(*<*)by(simp add: exec_all_def)(*>*)

lemma jvm_one_step1[trans]:
 " P  σ -jvm→1 σ'; P  σ' -jvm→ σ''   P  σ -jvm→ σ''"
(*<*) by (simp add: exec_all_def1) (*>*)

lemma jvm_one_step2[trans]:
 " P  σ -jvm→ σ'; P  σ' -jvm→1 σ''   P  σ -jvm→ σ''"
(*<*) by (simp add: exec_all_def1) (*>*)

lemma exec_all_conf:
  " P  σ -jvm→ σ'; P  σ -jvm→ σ'' 
   P  σ' -jvm→ σ''  P  σ'' -jvm→ σ'"
(*<*)by(simp add: exec_all_def single_valued_def single_valued_confluent)(*>*)

lemma exec_1_exec_all_conf:
 " exec (P, σ) = Some σ'; P  σ -jvm→ σ''; σ  σ'' 
  P  σ' -jvm→ σ''"
 by(auto elim: converse_rtranclE simp: exec_1_eq exec_all_def)

lemma exec_all_finalD: "P  (x, h, [], sh) -jvm→ σ  σ = (x, h, [], sh)"
(*<*)
proof -
  assume "P  (x, h, [], sh) -jvm→ σ"
  then have "((x, h, [], sh), σ)  {(σ, σ'). exec (P, σ) = σ'}*"
    by(simp only: exec_all_def)
  then show ?thesis proof(rule converse_rtranclE) qed simp+
qed
(*>*)

lemma exec_all_deterministic:
  " P  σ -jvm→ (x,h,[],sh); P  σ -jvm→ σ'   P  σ' -jvm→ (x,h,[],sh)"
(*<*)
proof -
  assume assms: "P  σ -jvm→ (x,h,[],sh)" "P  σ -jvm→ σ'"
  show ?thesis using exec_all_conf[OF assms]
    by(blast dest!: exec_all_finalD)
qed
(*>*)

subsection "Preservation of preallocated"

lemma exec_Calling_prealloc_pres:
assumes "preallocated h"
  and "exec_Calling C Cs P h stk loc C0 M0 pc frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
using assms
proof(cases "sh C")
  case (Some a)
  then obtain sfs i where sfsi:"a = (sfs, i)" by(cases a)
  then show ?thesis using Some assms
  proof(cases i)
    case Prepared
    then show ?thesis using sfsi Some assms by(cases "method P C clinit", auto split: if_split_asm)
  next
    case Error
    then show ?thesis using sfsi Some assms by(cases "method P C clinit", auto)
  qed(auto)
qed(auto)

lemma exec_step_prealloc_pres:
assumes pre: "preallocated h"
  and "exec_step P h stk loc C M pc ics frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
proof(cases ics)
  case No_ics
  then show ?thesis using exec_instr_prealloc_pres assms by auto
next
  case Calling
  then show ?thesis using exec_Calling_prealloc_pres assms by auto
next
  case (Called Cs)
  then show ?thesis using exec_instr_prealloc_pres assms by(cases Cs, auto)
next
  case (Throwing Cs a)
  then show ?thesis using assms by(cases Cs, auto)
qed

lemma exec_prealloc_pres:
assumes pre: "preallocated h"
  and "exec (P, xp, h, frs, sh) = Some(xp',h',frs',sh')"
shows "preallocated h'"
using assms
proof(cases "x. xp = x  frs = []")
  case False
  then obtain f1 frs1 where frs: "frs = f1#frs1" by(cases frs, simp+)
  then obtain stk1 loc1 C1 M1 pc1 ics1 where f1: "f1 = (stk1,loc1,C1,M1,pc1,ics1)" by(cases f1)
  let ?i = "instrs_of P C1 M1 ! pc1"
  obtain xp2 h2 frs2 sh2
     where exec_step: "exec_step P h stk1 loc1 C1 M1 pc1 ics1 frs1 sh = (xp2,h2,frs2,sh2)"
    by(cases "exec_step P h stk1 loc1 C1 M1 pc1 ics1 frs1 sh")
  then show ?thesis using exec_step_prealloc_pres[OF pre exec_step] f1 frs False assms
  proof(cases xp2)
    case (Some a)
    show ?thesis
      using find_handler_prealloc_pres[OF pre, where a=a]
            exec_step_prealloc_pres[OF pre]
            exec_step f1 frs Some False assms
       by(auto split: bool.splits init_call_status.splits list.splits)
  qed(auto split: init_call_status.splits)
qed(auto)

subsection "Start state"

text ‹ The @{term Start} class is defined based on a given initial class
 and method. It has two methods: one that calls the initial method in the
 initial class, which is called by the starting program, and @{term clinit},
 as required for the class to be well-formed. ›
definition start_method :: "cname  mname  jvm_method mdecl" where
"start_method C M = (start_m, Static, [], Void, (1,0,[Invokestatic C M 0,Return],[]))"
abbreviation start_clinit :: "jvm_method mdecl" where
"start_clinit  (clinit, Static, [], Void, (1,0,[Push Unit,Return],[]))"
definition start_class :: "cname  mname  jvm_method cdecl" where
"start_class C M = (Start, Object, [], [start_method C M, start_clinit])"

text ‹
  The start configuration of the JVM in program @{text P}:
  in the start heap, we call the ``start'' method of the
  ``Start''; this method performs @{text Invokestatic} on the
  class and method given to create the start program's @{term Start} class.
  This allows the initialization procedure to be called on the
  initial class in a natural way before the initial method is performed. 
  There is no @{text this} pointer of the frame as @{term start} is @{term Static}.
  The start sheap has every class pre-prepared; this decision is not
  necessary.
  The starting program includes the added @{term Start} class, given a 
  method @{text M} of class @{text C}, added to program @{text P}.
›
definition start_state :: "jvm_prog  jvm_state" where
  "start_state P = (None, start_heap P, [([], [], Start, start_m, 0, No_ics)], start_sheap)"
abbreviation start_prog :: "jvm_prog  cname  mname  jvm_prog" where
"start_prog P C M  start_class C M # P"

end

Theory JVMDefensive

(*  Title:      JinjaDCI/JVM/JVMDefensive.thy
    Author:     Gerwin Klein, Susannah Mansky
    Copyright   GPL

    Based on the Jinja theory JVM/JVMDefensive.thy by Gerwin Klein
*)

section ‹ A Defensive JVM ›

theory JVMDefensive
imports JVMExec "../Common/Conform"
begin

text ‹
  Extend the state space by one element indicating a type error (or
  other abnormal termination) ›
datatype 'a type_error = TypeError | Normal 'a

fun is_Addr :: "val  bool" where
  "is_Addr (Addr a)  True"
| "is_Addr v  False"

fun is_Intg :: "val  bool" where
  "is_Intg (Intg i)  True"
| "is_Intg v  False"

fun is_Bool :: "val  bool" where
  "is_Bool (Bool b)  True"
| "is_Bool v  False"

definition is_Ref :: "val  bool" where
  "is_Ref v  v = Null  is_Addr v"

primrec check_instr :: "[instr, jvm_prog, heap, val list, val list, 
                  cname, mname, pc, frame list, sheap]  bool" where
  check_instr_Load:
    "check_instr (Load n) P h stk loc C M0 pc frs sh = 
    (n < length loc)"

| check_instr_Store:
    "check_instr (Store n) P h stk loc C0 M0 pc frs sh = 
    (0 < length stk  n < length loc)"

| check_instr_Push:
    "check_instr (Push v) P h stk loc C0 M0 pc frs sh = 
    (¬is_Addr v)"

| check_instr_New:
    "check_instr (New C) P h stk loc C0 M0 pc frs sh = 
    is_class P C"

| check_instr_Getfield:
    "check_instr (Getfield F C) P h stk loc C0 M0 pc frs sh = 
    (0 < length stk  (C' T. P  C sees F,NonStatic:T in C')  
    (let (C', b, T) = field P C F; ref = hd stk in 
      C' = C  is_Ref ref  (ref  Null  
        h (the_Addr ref)  None  
        (let (D,vs) = the (h (the_Addr ref)) in 
          P  D * C  vs (F,C)  None  P,h  the (vs (F,C)) :≤ T))))" 

| check_instr_Getstatic:
    "check_instr (Getstatic C F D) P h stk loc C0 M0 pc frs sh = 
    ((T. P  C sees F,Static:T in D)  
    (let (C', b, T) = field P C F in 
      C' = D  (sh D  None 
        (let (sfs,i) = the (sh D) in 
          sfs F  None  P,h  the (sfs F) :≤ T))))" 

| check_instr_Putfield:
    "check_instr (Putfield F C) P h stk loc C0 M0 pc frs sh = 
    (1 < length stk  (C' T. P  C sees F,NonStatic:T in C') 
    (let (C', b, T) = field P C F; v = hd stk; ref = hd (tl stk) in 
      C' = C  is_Ref ref  (ref  Null  
        h (the_Addr ref)  None  
        (let D = fst (the (h (the_Addr ref))) in 
          P  D * C  P,h  v :≤ T))))" 

| check_instr_Putstatic:
    "check_instr (Putstatic C F D) P h stk loc C0 M0 pc frs sh = 
    (0 < length stk  (T. P  C sees F,Static:T in D) 
    (let (C', b, T) = field P C F; v = hd stk in 
      C' = D  P,h  v :≤ T))" 

| check_instr_Checkcast:
    "check_instr (Checkcast C) P h stk loc C0 M0 pc frs sh =
    (0 < length stk  is_class P C  is_Ref (hd stk))"

| check_instr_Invoke:
    "check_instr (Invoke M n) P h stk loc C0 M0 pc frs sh =
    (n < length stk  is_Ref (stk!n)   
    (stk!n  Null  
      (let a = the_Addr (stk!n); 
           C = cname_of h a;
           Ts = fst (snd (snd (method P C M)))
      in h a  None  P  C has M,NonStatic  
         P,h  rev (take n stk) [:≤] Ts)))"

| check_instr_Invokestatic:
    "check_instr (Invokestatic C M n) P h stk loc C0 M0 pc frs sh =
    (n  length stk 
      (let Ts = fst (snd (snd (method P C M)))
      in P  C has M,Static  
         P,h  rev (take n stk) [:≤] Ts))"
 
| check_instr_Return:
    "check_instr Return P h stk loc C0 M0 pc frs sh =
    (case (M0 = clinit) of False  (0 < length stk  ((0 < length frs)  
                                      (b. P  C0 has M0,b)     
                                      (let v = hd stk; 
                                           T = fst (snd (snd (snd (method P C0 M0))))
                                       in P,h  v :≤ T)))
                        | True  P  C0 has M0,Static)"
 
| check_instr_Pop:
    "check_instr Pop P h stk loc C0 M0 pc frs sh = 
    (0 < length stk)"

| check_instr_IAdd:
    "check_instr IAdd P h stk loc C0 M0 pc frs sh =
    (1 < length stk  is_Intg (hd stk)  is_Intg (hd (tl stk)))"

| check_instr_IfFalse:
    "check_instr (IfFalse b) P h stk loc C0 M0 pc frs sh =
    (0 < length stk  is_Bool (hd stk)  0  int pc+b)"

| check_instr_CmpEq:
    "check_instr CmpEq P h stk loc C0 M0 pc frs sh =
    (1 < length stk)"

| check_instr_Goto:
    "check_instr (Goto b) P h stk loc C0 M0 pc frs sh =
    (0  int pc+b)"

| check_instr_Throw:
    "check_instr Throw P h stk loc C0 M0 pc frs sh =
    (0 < length stk  is_Ref (hd stk))"

definition check :: "jvm_prog  jvm_state  bool" where
  "check P σ = (let (xcpt, h, frs, sh) = σ in
               (case frs of []  True | (stk,loc,C,M,pc,ics)#frs'  
                b. P  C has M, b 
                (let (C',b,Ts,T,mxs,mxl0,ins,xt) = method P C M; i = ins!pc in
                 pc < size ins  size stk  mxs 
                 check_instr i P h stk loc C M pc frs' sh)))"


definition exec_d :: "jvm_prog  jvm_state  jvm_state option type_error" where
  "exec_d P σ = (if check P σ then Normal (exec (P, σ)) else TypeError)"


inductive_set
  exec_1_d :: "jvm_prog  (jvm_state type_error × jvm_state type_error) set" 
  and exec_1_d' :: "jvm_prog  jvm_state type_error  jvm_state type_error  bool" 
                   ("_  _ -jvmd→1 _" [61,61,61]60)
  for P :: jvm_prog
where
  "P  σ -jvmd→1 σ'  (σ,σ')  exec_1_d P"
| exec_1_d_ErrorI: "exec_d P σ = TypeError  P  Normal σ -jvmd→1 TypeError"
| exec_1_d_NormalI: "exec_d P σ = Normal (Some σ')  P  Normal σ -jvmd→1 Normal σ'"

― ‹reflexive transitive closure:›
definition exec_all_d :: "jvm_prog  jvm_state type_error  jvm_state type_error  bool" 
    ("_  _ -jvmd→ _" [61,61,61]60) where
  exec_all_d_def1: "P  σ -jvmd→ σ'  (σ,σ')  (exec_1_d P)*"

notation (ASCII)
  "exec_all_d"  ("_ |- _ -jvmd-> _" [61,61,61]60)

lemma exec_1_d_eq:
  "exec_1_d P = {(s,t). σ. s = Normal σ  t = TypeError  exec_d P σ = TypeError}  
                {(s,t). σ σ'. s = Normal σ  t = Normal σ'  exec_d P σ = Normal (Some σ')}"
by (auto elim!: exec_1_d.cases intro!: exec_1_d.intros)


declare split_paired_All [simp del]
declare split_paired_Ex [simp del]

lemma if_neq [dest!]:
  "(if P then A else B)  B  P"
  by (cases P, auto)

lemma exec_d_no_errorI [intro]:
  "check P σ  exec_d P σ  TypeError"
  by (unfold exec_d_def) simp

theorem no_type_error_commutes:
  "exec_d P σ  TypeError  exec_d P σ = Normal (exec (P, σ))"
  by (unfold exec_d_def, auto)


lemma defensive_imp_aggressive:
  "P  (Normal σ) -jvmd→ (Normal σ')  P  σ -jvm→ σ'"
(*<*)
proof -
  have "x y. P  x -jvmd→ y  σ σ'. x = Normal σ  y = Normal σ'   P  σ -jvm→ σ'"
  proof -
    fix x y assume xy: "P  x -jvmd→ y"
    then have "(x, y)  (exec_1_d P)*" by (unfold exec_all_d_def1)
    then show "σ σ'. x = Normal σ  y = Normal σ'   P  σ -jvm→ σ'"
    proof(induct rule: rtrancl_induct)
      case base
      then show ?case by (simp add: exec_all_def)
    next
      case (step y' z')
      show ?case proof(induct rule: exec_1_d.cases[OF step.hyps(2)])
        case (2 σ σ')
        then have "(σ, σ')  {(σ, σ'). exec (P, σ) = σ'}*" using step
          by(fastforce simp: exec_d_def split: type_error.splits if_split_asm)
        then show ?case using step 2 by (auto simp: exec_all_def)
      qed simp
    qed
  qed
  moreover
  assume "P  (Normal σ) -jvmd→ (Normal σ')" 
  ultimately
  show "P  σ -jvm→ σ'" by blast
qed
(*>*)

end

Theory SemiType

(*  Title:      Jinja/BV/SemiType.thy

    Author:     Tobias Nipkow, Gerwin Klein
    Copyright   2000 TUM
*)

section ‹ The Jinja Type System as a Semilattice ›

theory SemiType
imports "../Common/WellForm" Jinja.Semilattices
begin

definition super :: "'a prog  cname  cname"
where "super P C  fst (the (class P C))"

lemma superI:
  "(C,D)  subcls1 P  super P C = D"
  by (unfold super_def) (auto dest: subcls1D)


primrec the_Class :: "ty  cname"
where
  "the_Class (Class C) = C"

definition sup :: "'c prog  ty  ty  ty err"
where
  "sup P T1 T2 
  if is_refT T1  is_refT T2 then 
  OK (if T1 = NT then T2 else
      if T2 = NT then T1 else
      (Class (exec_lub (subcls1 P) (super P) (the_Class T1) (the_Class T2))))
  else 
  (if T1 = T2 then OK T1 else Err)"

lemma sup_def':
  "sup P = (λT1 T2.
  if is_refT T1  is_refT T2 then 
  OK (if T1 = NT then T2 else
      if T2 = NT then T1 else
      (Class (exec_lub (subcls1 P) (super P) (the_Class T1) (the_Class T2))))
  else 
  (if T1 = T2 then OK T1 else Err))"
  by (simp add: sup_def fun_eq_iff)

abbreviation
  subtype :: "'c prog  ty  ty  bool"
  where "subtype P  widen P"

definition esl :: "'c prog  ty esl"
where
  "esl P  (types P, subtype P, sup P)"


(* FIXME: move to wellform *)
lemma is_class_is_subcls:
  "wf_prog m P  is_class P C = P  C * Object"
(*<*)by (fastforce simp:is_class_def
                  elim: subcls_C_Object converse_rtranclE subcls1I
                  dest: subcls1D)
(*>*)


(* FIXME: move to wellform *)
lemma subcls_antisym:
  "wf_prog m P; P  C * D; P  D * C  C = D"
  (*<*) by (auto dest: acyclic_subcls1 acyclic_impl_antisym_rtrancl antisymD) (*>*)

(* FIXME: move to wellform *)
lemma widen_antisym:
  " wf_prog m P; P  T  U; P  U  T   T = U"
(*<*)
apply (cases T)
 apply (cases U)
 apply auto
apply (cases U)
 apply (auto elim!: subcls_antisym)
done
(*>*)

lemma order_widen [intro,simp]: 
  "wf_prog m P  order (subtype P)"
(*<*)
  apply (unfold Semilat.order_def lesub_def)
  apply (auto intro: widen_trans widen_antisym)
  done
(*>*)

(* FIXME: move to TypeRel *)
lemma NT_widen:
  "P  NT  T = (T = NT  (C. T = Class C))"
(*<*) by (cases T) auto (*>*)

(* FIXME: move to TypeRel *)
lemma Class_widen2: "P  Class C  T = (D. T = Class D  P  C * D)"
(*<*) by (cases T) auto (*>*)
 
lemma wf_converse_subcls1_impl_acc_subtype:
  "wf ((subcls1 P)^-1)  acc (subtype P)"
(*<*)
apply (unfold Semilat.acc_def lesssub_def)
apply (drule_tac p = "(subcls1 P)^-1 - Id" in wf_subset)
 apply blast
apply (drule wf_trancl)
apply (simp add: wf_eq_minimal)
apply clarify
apply (unfold lesub_def)
apply (rename_tac M T) 
apply (case_tac "C. Class C  M")
 prefer 2
 apply (case_tac T)
     apply fastforce
    apply fastforce
   apply fastforce
  apply simp
  apply (rule_tac x = NT in bexI)
   apply (rule allI)
   apply (rule impI, erule conjE) 
   apply (clarsimp simp add: NT_widen)
  apply simp
 apply clarsimp
apply (erule_tac x = "{C. Class C : M}" in allE)
apply auto
apply (rename_tac D)
apply (rule_tac x = "Class D" in bexI)
 prefer 2
 apply assumption
apply clarify
apply (clarsimp simp: Class_widen2)
apply (insert rtrancl_r_diff_Id [symmetric, of "subcls1 P"])
apply simp
apply (erule rtranclE)
 apply blast
apply (drule rtrancl_converseI)
apply (subgoal_tac "((subcls1 P)-Id)^-1 = ((subcls1 P)^-1 - Id)")
 prefer 2
 apply blast
apply simp
apply (blast intro: rtrancl_into_trancl2)
done
(*>*)

lemma wf_subtype_acc [intro, simp]:
  "wf_prog wf_mb P  acc (subtype P)"
(*<*) by (rule wf_converse_subcls1_impl_acc_subtype, rule wf_subcls1) (*>*)

lemma exec_lub_refl [simp]: "exec_lub r f T T = T"
(*<*) by (simp add: exec_lub_def while_unfold) (*>*)

lemma closed_err_types:
  "wf_prog wf_mb P  closed (err (types P)) (lift2 (sup P))"
(*<*)
  apply (unfold closed_def plussub_def lift2_def sup_def')
  apply (frule acyclic_subcls1)
  apply (frule single_valued_subcls1)
  apply (auto simp: is_type_def is_refT_def is_class_is_subcls split: err.split ty.splits)
  apply (blast dest!: is_lub_exec_lub is_lubD is_ubD intro!: is_ubI superI)
  done
(*>*)


lemma sup_subtype_greater:
  " wf_prog wf_mb P; is_type P t1; is_type P t2; sup P t1 t2 = OK s  
   subtype P t1 s  subtype P t2 s"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"
 
  { fix c1 c2
    assume is_class: "is_class P c1" "is_class P c2"
    with wf_prog 
    obtain 
      "P  c1 * Object"
      "P  c2 * Object"
      by (blast intro: subcls_C_Object)
    with single_valued_subcls1[OF wf_prog]
    obtain u where
      "is_lub ((subcls1 P)^* ) c1 c2 u"      
      by (blast dest: single_valued_has_lubs)
    moreover
    note acyclic_subcls1[OF wf_prog]
    moreover
    have "x y. (x, y)  subcls1 P  super P x = y"
      by (blast intro: superI)
    ultimately
    have "P  c1 * exec_lub (subcls1 P) (super P) c1 c2 
          P  c2 * exec_lub (subcls1 P) (super P) c1 c2"
      by (simp add: exec_lub_conv) (blast dest: is_lubD is_ubD)
  } note this [simp]

  assume "is_type P t1" "is_type P t2" "sup P t1 t2 = OK s"
  thus ?thesis
    apply (unfold sup_def) 
    apply (cases s)
    apply (auto simp add: is_refT_def split: if_split_asm)
    done
qed
(*>*)

lemma sup_subtype_smallest:
  " wf_prog wf_mb P; is_type P a; is_type P b; is_type P c; 
      subtype P a c; subtype P b c; sup P a b = OK d 
   subtype P d c"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"

  { fix c1 c2 D
    assume is_class: "is_class P c1" "is_class P c2"
    assume le: "P  c1 * D" "P  c2 * D"
    from wf_prog is_class
    obtain 
      "P  c1 * Object"
      "P  c2 * Object"
      by (blast intro: subcls_C_Object)
    with single_valued_subcls1[OF wf_prog]
    obtain u where
      lub: "is_lub ((subcls1 P)^* ) c1 c2 u"
      by (blast dest: single_valued_has_lubs)   
    with acyclic_subcls1[OF wf_prog]
    have "exec_lub (subcls1 P) (super P) c1 c2 = u"
      by (blast intro: superI exec_lub_conv)
    moreover
    from lub le
    have "P  u * D" 
      by (simp add: is_lub_def is_ub_def)
    ultimately     
    have "P  exec_lub (subcls1 P) (super P) c1 c2 * D"
      by blast
  } note this [intro]

  have [dest!]:
    "C T. P  Class C  T  D. T=Class D  P  C * D"
    by (frule Class_widen, auto)

  assume "is_type P a" "is_type P b" "is_type P c"
         "subtype P a c" "subtype P b c" "sup P a b = OK d"
  thus ?thesis
    by (auto simp add: sup_def is_refT_def
             split: if_split_asm)
qed
(*>*)

lemma sup_exists:
  " subtype P a c; subtype P b c   T. sup P a b = OK T"
(*<*)
apply (unfold sup_def)
apply (cases b)
apply auto
apply (cases a)
apply auto
apply (cases a)
apply auto
done
(*>*)

lemma err_semilat_JType_esl:
  "wf_prog wf_mb P  err_semilat (esl P)"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"  
  hence "order (subtype P)"..
  moreover from wf_prog
  have "closed (err (types P)) (lift2 (sup P))"
    by (rule closed_err_types)
  moreover
  from wf_prog have
    "(xerr (types P). yerr (types P). xErr.le (subtype P) xlift2 (sup P) y)  
     (xerr (types P). yerr (types P). yErr.le (subtype P) xlift2 (sup P) y)"
    by (auto simp add: lesub_def plussub_def Err.le_def lift2_def sup_subtype_greater split: err.split)
  moreover from wf_prog have
    "xerr (types P). yerr (types P). zerr (types P). 
    xErr.le (subtype P) z  yErr.le (subtype P) z  xlift2 (sup P) yErr.le (subtype P) z"
    by (unfold lift2_def plussub_def lesub_def Err.le_def)
       (auto intro: sup_subtype_smallest dest:sup_exists split: err.split)
  ultimately show ?thesis by (simp add: esl_def semilat_def sl_def Err.sl_def)
qed
(*>*)


end

Theory JVM_SemiType

(*  Title:      HOL/MicroJava/BV/JVM.thy

    Author:     Gerwin Klein
    Copyright   2000 TUM

*)

section ‹ The JVM Type System as Semilattice ›

theory JVM_SemiType imports SemiType begin

type_synonym tyl = "ty err list"
type_synonym tys = "ty list"
type_synonym tyi = "tys × tyl"
type_synonym tyi' = "tyi option"
type_synonym tym = "tyi' list"
type_synonym tyP = "mname  cname  tym"


definition stk_esl :: "'c prog  nat  tys esl"
where
  "stk_esl P mxs  upto_esl mxs (SemiType.esl P)"

definition loc_sl :: "'c prog  nat  tyl sl"
where
  "loc_sl P mxl  Listn.sl mxl (Err.sl (SemiType.esl P))"

definition sl :: "'c prog  nat  nat  tyi' err sl"
where
  "sl P mxs mxl 
  Err.sl(Opt.esl(Product.esl (stk_esl P mxs) (Err.esl(loc_sl P mxl))))"


definition states :: "'c prog  nat  nat  tyi' err set"
where "states P mxs mxl  fst(sl P mxs mxl)"

definition le :: "'c prog  nat  nat  tyi' err ord"
where
  "le P mxs mxl  fst(snd(sl P mxs mxl))"

definition sup :: "'c prog  nat  nat  tyi' err binop"
where
  "sup P mxs mxl  snd(snd(sl P mxs mxl))"


definition sup_ty_opt :: "['c prog,ty err,ty err]  bool" 
    ("_  _  _" [71,71,71] 70)
where
  "sup_ty_opt P  Err.le (subtype P)"

definition sup_state :: "['c prog,tyi,tyi]  bool"   
    ("_  _ i _" [71,71,71] 70)
where
  "sup_state P  Product.le (Listn.le (subtype P)) (Listn.le (sup_ty_opt P))"

definition sup_state_opt :: "['c prog,tyi',tyi']  bool" 
    ("_  _ ≤'' _" [71,71,71] 70)
where
  "sup_state_opt P  Opt.le (sup_state P)"

abbreviation
  sup_loc :: "['c prog,tyl,tyl]  bool"  ("_  _ [≤] _"  [71,71,71] 70)
  where "P  LT [≤] LT'  list_all2 (sup_ty_opt P) LT LT'"

notation (ASCII)
  sup_ty_opt  ("_ |- _ <=T _" [71,71,71] 70) and
  sup_state  ("_ |- _ <=i _"  [71,71,71] 70) and
  sup_state_opt  ("_ |- _ <=' _"  [71,71,71] 70) and
  sup_loc  ("_ |- _ [<=T] _"  [71,71,71] 70)


subsection "Unfolding"

lemma JVM_states_unfold: 
  "states P mxs mxl  err(opt((Union {list n (types P) |n. n <= mxs}) ×
                                 list mxl (err(types P))))"
(*<*)
  apply (unfold states_def sl_def Opt.esl_def Err.sl_def
         stk_esl_def loc_sl_def Product.esl_def
         Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def)
  apply simp
  done
(*>*)

lemma JVM_le_unfold:
 "le P m n  
  Err.le(Opt.le(Product.le(Listn.le(subtype P))(Listn.le(Err.le(subtype P)))))" 
(*<*)
  apply (unfold le_def sl_def Opt.esl_def Err.sl_def
         stk_esl_def loc_sl_def Product.esl_def  
         Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def) 
  apply simp
  done
(*>*)
    
lemma sl_def2:
  "JVM_SemiType.sl P mxs mxl  
  (states P mxs mxl, JVM_SemiType.le P mxs mxl, JVM_SemiType.sup P mxs mxl)"
(*<*) by (unfold JVM_SemiType.sup_def states_def JVM_SemiType.le_def) simp (*>*)


lemma JVM_le_conv:
  "le P m n (OK t1) (OK t2) = P  t1 ≤' t2"
(*<*) by (simp add: JVM_le_unfold Err.le_def lesub_def sup_state_opt_def  
                sup_state_def sup_ty_opt_def) (*>*)

lemma JVM_le_Err_conv:
  "le P m n = Err.le (sup_state_opt P)"
(*<*) by (unfold sup_state_opt_def sup_state_def  
             sup_ty_opt_def JVM_le_unfold) simp (*>*)

lemma err_le_unfold [iff]: 
  "Err.le r (OK a) (OK b) = r a b"
(*<*) by (simp add: Err.le_def lesub_def) (*>*)
  

subsection ‹ Semilattice ›

lemma order_sup_state_opt [intro, simp]: 
  "wf_prog wf_mb P  order (sup_state_opt P)"   
(*<*) by (unfold sup_state_opt_def sup_state_def sup_ty_opt_def) blast (*>*)

lemma semilat_JVM [intro?]:
  "wf_prog wf_mb P  semilat (JVM_SemiType.sl P mxs mxl)"
(*<*)
  apply (unfold JVM_SemiType.sl_def stk_esl_def loc_sl_def)  
  apply (blast intro: err_semilat_Product_esl err_semilat_upto_esl 
                      Listn_sl err_semilat_JType_esl)
  done
(*>*)

lemma acc_JVM [intro]:
  "wf_prog wf_mb P  acc (JVM_SemiType.le P mxs mxl)"
(*<*) by (unfold JVM_le_unfold) blast (*>*)


subsection ‹ Widening with @{text "⊤"}

lemma subtype_refl[iff]: "subtype P t t" (*<*) by (simp add: fun_of_def) (*>*)

lemma sup_ty_opt_refl [iff]: "P  T  T"
(*<*)
  apply (unfold sup_ty_opt_def)
  apply (fold lesub_def)
  apply (rule le_err_refl)
  apply (simp add: lesub_def)
  done
(*>*)

lemma Err_any_conv [iff]: "P  Err  T = (T = Err)"
(*<*) by (unfold sup_ty_opt_def) (rule Err_le_conv [simplified lesub_def]) (*>*)

lemma any_Err [iff]: "P  T  Err"
(*<*) by (unfold sup_ty_opt_def) (rule le_Err [simplified lesub_def]) (*>*)

lemma OK_OK_conv [iff]:
  "P  OK T  OK T' = P  T  T'"
(*<*) by (simp add: sup_ty_opt_def fun_of_def) (*>*)

lemma any_OK_conv [iff]:
  "P  X  OK T' = (T. X = OK T  P  T  T')"
(*<*)
  apply (unfold sup_ty_opt_def) 
  apply (rule le_OK_conv [simplified lesub_def])
  done  
(*>*)

lemma OK_any_conv:
 "P  OK T  X = (X = Err  (T'. X = OK T'  P  T  T'))"
(*<*)
  apply (unfold sup_ty_opt_def) 
  apply (rule OK_le_conv [simplified lesub_def])
  done
(*>*)

lemma sup_ty_opt_trans [intro?, trans]:
  "P  a  b; P  b  c  P  a  c"
(*<*) by (auto intro: widen_trans  
           simp add: sup_ty_opt_def Err.le_def lesub_def fun_of_def
           split: err.splits) (*>*)


subsection "Stack and Registers"

lemma stk_convert:
  "P  ST [≤] ST' = Listn.le (subtype P) ST ST'"
(*<*) by (simp add: Listn.le_def lesub_def) (*>*)

lemma sup_loc_refl [iff]: "P  LT [≤] LT"
(*<*) by (rule list_all2_refl) simp (*>*)

lemmas sup_loc_Cons1 [iff] = list_all2_Cons1 [of "sup_ty_opt P"] for P

lemma sup_loc_def:
  "P  LT [≤] LT'  Listn.le (sup_ty_opt P) LT LT'"
(*<*) by (simp add: Listn.le_def lesub_def) (*>*)

lemma sup_loc_widens_conv [iff]:
  "P  map OK Ts [≤] map OK Ts' = P  Ts [≤] Ts'"
(*<*)
  by (simp add: list_all2_map1 list_all2_map2)
(*>*)


lemma sup_loc_trans [intro?, trans]:
  "P  a [≤] b; P  b [≤] c  P  a [≤] c"
(*<*) by (rule list_all2_trans, rule sup_ty_opt_trans) (*>*)


subsection "State Type"

lemma sup_state_conv [iff]:
  "P  (ST,LT) i (ST',LT') = (P  ST [≤] ST'  P  LT [≤] LT')"
(*<*) by (auto simp add: sup_state_def stk_convert lesub_def Product.le_def sup_loc_def) (*>*)
  
lemma sup_state_conv2:
  "P  s1 i s2 = (P  fst s1 [≤] fst s2  P  snd s1 [≤] snd s2)"
(*<*) by (cases s1, cases s2) simp (*>*)

lemma sup_state_refl [iff]: "P  s i s"
(*<*) by (auto simp add: sup_state_conv2) (*>*)

lemma sup_state_trans [intro?, trans]:
  "P  a i b; P  b i c  P  a i c"
(*<*) by (auto intro: sup_loc_trans widens_trans simp add: sup_state_conv2) (*>*)


lemma sup_state_opt_None_any [iff]:
  "P  None ≤' s"
(*<*) by (simp add: sup_state_opt_def Opt.le_def) (*>*)

lemma sup_state_opt_any_None [iff]:
  "P  s ≤' None = (s = None)"
(*<*) by (simp add: sup_state_opt_def Opt.le_def) (*>*)

lemma sup_state_opt_Some_Some [iff]:
  "P  Some a ≤' Some b = P  a i b"  
(*<*) by (simp add: sup_state_opt_def Opt.le_def lesub_def) (*>*)

lemma sup_state_opt_any_Some:
  "P  (Some s) ≤' X = (s'. X = Some s'  P  s i s')"
(*<*) by (simp add: sup_state_opt_def Opt.le_def lesub_def) (*>*)

lemma sup_state_opt_refl [iff]: "P  s ≤' s"
(*<*) by (simp add: sup_state_opt_def Opt.le_def lesub_def) (*>*)

lemma sup_state_opt_trans [intro?, trans]:
  "P  a ≤' b; P  b ≤' c  P  a ≤' c"
(*<*)
  apply (unfold sup_state_opt_def Opt.le_def lesub_def)
  apply (simp del: split_paired_All)
  apply (rule sup_state_trans, assumption+)
  done
(*>*)

end

Theory Effect

(*  Title:      JinjaDCI/BV/Effect.thy
    Author:     Gerwin Klein, Susannah Mansky
    Copyright   2000 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory BV/Effect.thy by Gerwin Klein
*)

section ‹Effect of Instructions on the State Type›

theory Effect
imports JVM_SemiType "../JVM/JVMExceptions"
begin

― ‹FIXME›
locale prog =
  fixes P :: "'a prog"

locale jvm_method = prog +
  fixes mxs :: nat  
  fixes mxl0 :: nat   
  fixes Ts :: "ty list" 
  fixes Tr :: ty
  fixes "is" :: "instr list" 
  fixes xt :: ex_table

  fixes mxl :: nat
  defines mxl_def: "mxl  1+size Ts+mxl0"

text ‹ Program counter of successor instructions: ›
primrec succs :: "instr  tyi  pc  pc list" where
  "succs (Load idx) τ pc     = [pc+1]"
| "succs (Store idx) τ pc    = [pc+1]"
| "succs (Push v) τ pc       = [pc+1]"
| "succs (Getfield F C) τ pc = [pc+1]"
| "succs (Getstatic C F D) τ pc = [pc+1]"
| "succs (Putfield F C) τ pc = [pc+1]"
| "succs (Putstatic C F D) τ pc = [pc+1]"
| "succs (New C) τ pc        = [pc+1]"
| "succs (Checkcast C) τ pc  = [pc+1]"
| "succs Pop τ pc            = [pc+1]"
| "succs IAdd τ pc           = [pc+1]"
| "succs CmpEq τ pc          = [pc+1]"
| succs_IfFalse:
    "succs (IfFalse b) τ pc    = [pc+1, nat (int pc + b)]"
| succs_Goto:
    "succs (Goto b) τ pc       = [nat (int pc + b)]"
| succs_Return:
    "succs Return τ pc         = []"  
| succs_Invoke:
    "succs (Invoke M n) τ pc   = (if (fst τ)!n = NT then [] else [pc+1])"
| succs_Invokestatic:
    "succs (Invokestatic C M n) τ pc   = [pc+1]"
| succs_Throw:
    "succs Throw τ pc          = []"

text "Effect of instruction on the state type:"

fun the_class:: "ty  cname" where
  "the_class (Class C) = C"

fun effi :: "instr × 'm prog × tyi  tyi" where
  effi_Load:
    "effi (Load n,  P, (ST, LT))          = (ok_val (LT ! n) # ST, LT)"
| effi_Store:
    "effi (Store n, P, (T#ST, LT))        = (ST, LT[n:= OK T])"
| effi_Push:
    "effi (Push v, P, (ST, LT))             = (the (typeof v) # ST, LT)"
| effi_Getfield:
    "effi (Getfield F C, P, (T#ST, LT))    = (snd (snd (field P C F)) # ST, LT)"
| effi_Getstatic:
    "effi (Getstatic C F D, P, (ST, LT))    = (snd (snd (field P C F)) # ST, LT)"
| effi_Putfield:
   "effi (Putfield F C, P, (T1#T2#ST, LT)) = (ST,LT)"
| effi_Putstatic:
   "effi (Putstatic C F D, P, (T#ST, LT)) = (ST,LT)"
| effi_New:
   "effi (New C, P, (ST,LT))               = (Class C # ST, LT)"
| effi_Checkcast:
   "effi (Checkcast C, P, (T#ST,LT))       = (Class C # ST,LT)"
| effi_Pop:
   "effi (Pop, P, (T#ST,LT))               = (ST,LT)"
| effi_IAdd:
   "effi (IAdd, P,(T1#T2#ST,LT))           = (Integer#ST,LT)"
| effi_CmpEq:
   "effi (CmpEq, P, (T1#T2#ST,LT))         = (Boolean#ST,LT)"
| effi_IfFalse:
   "effi (IfFalse b, P, (T1#ST,LT))        = (ST,LT)"
| effi_Invoke:
   "effi (Invoke M n, P, (ST,LT))          =
    (let C = the_class (ST!n); (D,b,Ts,Tr,m) = method P C M
     in (Tr # drop (n+1) ST, LT))"
| effi_Invokestatic:
   "effi (Invokestatic C M n, P, (ST,LT))  =
    (let (D,b,Ts,Tr,m) = method P C M
     in (Tr # drop n ST, LT))"
| effi_Goto:
   "effi (Goto n, P, s)                    = s"

fun is_relevant_class :: "instr  'm prog  cname  bool" where
  rel_Getfield:
    "is_relevant_class (Getfield F D)
     = (λP C. P  NullPointer * C  P  NoSuchFieldError * C
             P  IncompatibleClassChangeError * C)" 
| rel_Getstatic:
    "is_relevant_class (Getstatic C F D)
     = (λP C. True)"
| rel_Putfield:
    "is_relevant_class (Putfield F D)
     = (λP C. P  NullPointer * C  P  NoSuchFieldError * C
             P  IncompatibleClassChangeError * C)" 
| rel_Putstatic:
    "is_relevant_class (Putstatic C F D)
     = (λP C. True)" 
| rel_Checkcast:
    "is_relevant_class (Checkcast D)  = (λP C. P  ClassCast * C)" 
| rel_New:
    "is_relevant_class (New D)        = (λP C. True)"
| rel_Throw:
    "is_relevant_class Throw          = (λP C. True)"
| rel_Invoke:
    "is_relevant_class (Invoke M n)   = (λP C. True)"
| rel_Invokestatic:
    "is_relevant_class (Invokestatic C M n)   = (λP C. True)"
| rel_default:
    "is_relevant_class i              = (λP C. False)"

definition is_relevant_entry :: "'m prog  instr  pc  ex_entry  bool" where
  "is_relevant_entry P i pc e  (let (f,t,C,h,d) = e in is_relevant_class i P C  pc  {f..<t})"

definition relevant_entries :: "'m prog  instr  pc  ex_table  ex_table" where
  "relevant_entries P i pc = filter (is_relevant_entry P i pc)"

definition xcpt_eff :: "instr  'm prog  pc  tyi 
                ex_table  (pc × tyi') list" where    
  "xcpt_eff i P pc τ et = (let (ST,LT) = τ in 
  map (λ(f,t,C,h,d). (h, Some (Class C#drop (size ST - d) ST, LT))) (relevant_entries P i pc et))"

definition norm_eff :: "instr  'm prog  nat  tyi  (pc × tyi') list" where
  "norm_eff i P pc τ = map (λpc'. (pc',Some (effi (i,P,τ)))) (succs i τ pc)"

definition eff :: "instr  'm prog  pc  ex_table  tyi'  (pc × tyi') list" where
  "eff i P pc et t = (case t of           
    None  []          
  | Some τ  (norm_eff i P pc τ) @ (xcpt_eff i P pc τ et))"


lemma eff_None:
  "eff i P pc xt None = []"
by (simp add: eff_def)

lemma eff_Some:
  "eff i P pc xt (Some τ) = norm_eff i P pc τ @ xcpt_eff i P pc τ xt"
by (simp add: eff_def)

(* FIXME: getfield, ∃T D. P ⊢ C sees F:T in D ∧ .. *)

text "Conditions under which eff is applicable:"

fun appi :: "instr × 'm prog × pc × nat × ty × tyi  bool" where
  appi_Load:
    "appi (Load n, P, pc, mxs, Tr, (ST,LT)) = 
    (n < length LT  LT ! n  Err  length ST < mxs)"
| appi_Store:
    "appi (Store n, P, pc, mxs, Tr, (T#ST, LT)) = 
    (n < length LT)"
| appi_Push:
    "appi (Push v, P, pc, mxs, Tr, (ST,LT)) = 
     (length ST < mxs  typeof v  None)"
| appi_Getfield:
    "appi (Getfield F C, P, pc, mxs, Tr, (T#ST, LT)) = 
    (Tf. P  C sees F,NonStatic:Tf in C  P  T  Class C)"
| appi_Getstatic:
    "appi (Getstatic C F D, P, pc, mxs, Tr, (ST, LT)) = 
     (length ST < mxs  (Tf. P  C sees F,Static:Tf in D))"
| appi_Putfield:
    "appi (Putfield F C, P, pc, mxs, Tr, (T1#T2#ST, LT)) = 
    (Tf. P  C sees F,NonStatic:Tf in C  P  T2  (Class C)  P  T1  Tf)" 
| appi_Putstatic:
    "appi (Putstatic C F D, P, pc, mxs, Tr, (T#ST, LT)) = 
    (Tf. P  C sees F,Static:Tf in D  P  T  Tf)" 
| appi_New:
    "appi (New C, P, pc, mxs, Tr, (ST,LT)) = 
    (is_class P C  length ST < mxs)"
| appi_Checkcast:
    "appi (Checkcast C, P, pc, mxs, Tr, (T#ST,LT)) = 
    (is_class P C  is_refT T)"
| appi_Pop:
    "appi (Pop, P, pc, mxs, Tr, (T#ST,LT)) = 
    True"
| appi_IAdd:
    "appi (IAdd, P, pc, mxs, Tr, (T1#T2#ST,LT)) = (T1 = T2  T1 = Integer)"
| appi_CmpEq:
    "appi (CmpEq, P, pc, mxs, Tr, (T1#T2#ST,LT)) =
    (T1 = T2  is_refT T1  is_refT T2)"
| appi_IfFalse:
    "appi (IfFalse b, P, pc, mxs, Tr, (Boolean#ST,LT)) = 
    (0  int pc + b)"
| appi_Goto:
    "appi (Goto b, P, pc, mxs, Tr, s) = 
    (0  int pc + b)"
| appi_Return:
    "appi (Return, P, pc, mxs, Tr, (T#ST,LT)) = 
    (P  T  Tr)"
| appi_Throw:
    "appi (Throw, P, pc, mxs, Tr, (T#ST,LT)) = 
    is_refT T"
| appi_Invoke:
    "appi (Invoke M n, P, pc, mxs, Tr, (ST,LT)) =
    (n < length ST  
    (ST!n  NT 
      (C D Ts T m. ST!n = Class C  P  C sees M,NonStatic:Ts  T = m in D 
                    P  rev (take n ST) [≤] Ts)))"
| appi_Invokestatic:
    "appi (Invokestatic C M n, P, pc, mxs, Tr, (ST,LT)) =
    (length ST - n < mxs  n  length ST  M  clinit 
      (D Ts T m. P  C sees M,Static:Ts  T = m in D 
                    P  rev (take n ST) [≤] Ts))"
    
| appi_default:
    "appi (i,P, pc,mxs,Tr,s) = False"


definition xcpt_app :: "instr  'm prog  pc  nat  ex_table  tyi  bool" where
  "xcpt_app i P pc mxs xt τ  ((f,t,C,h,d)  set (relevant_entries P i pc xt). is_class P C  d  size (fst τ)  d < mxs)"

definition app :: "instr  'm prog  nat  ty  nat  nat  ex_table  tyi'  bool" where
  "app i P mxs Tr pc mpc xt t = (case t of None  True | Some τ  
  appi (i,P,pc,mxs,Tr,τ)  xcpt_app i P pc mxs xt τ  
  ((pc',τ')  set (eff i P pc xt t). pc' < mpc))"


lemma app_Some:
  "app i P mxs Tr pc mpc xt (Some τ) = 
  (appi (i,P,pc,mxs,Tr,τ)  xcpt_app i P pc mxs xt τ  
  ((pc',s')  set (eff i P pc xt (Some τ)). pc' < mpc))"
by (simp add: app_def)

locale eff = jvm_method +
  fixes effi and appi and eff and app 
  fixes norm_eff and xcpt_app and xcpt_eff

  fixes mpc
  defines "mpc  size is"

  defines "effi i τ  Effect.effi (i,P,τ)"
  notes effi_simps [simp] = Effect.effi.simps [where P = P, folded effi_def]

  defines "appi i pc τ  Effect.appi (i, P, pc, mxs, Tr, τ)"
  notes appi_simps [simp] = Effect.appi.simps [where P=P and mxs=mxs and Tr=Tr, folded appi_def]

  defines "xcpt_eff i pc τ  Effect.xcpt_eff i P pc τ xt"
  notes xcpt_eff = Effect.xcpt_eff_def [of _ P _ _ xt, folded xcpt_eff_def]

  defines "norm_eff i pc τ  Effect.norm_eff i P pc τ"
  notes norm_eff = Effect.norm_eff_def [of _ P, folded norm_eff_def effi_def]

  defines "eff i pc  Effect.eff i P pc xt"
  notes eff = Effect.eff_def [of _ P  _ xt, folded eff_def norm_eff_def xcpt_eff_def]

  defines "xcpt_app i pc τ  Effect.xcpt_app i P pc mxs xt τ"
  notes xcpt_app = Effect.xcpt_app_def [of _ P _ mxs xt, folded xcpt_app_def]

  defines "app i pc  Effect.app i P mxs Tr pc mpc xt"
  notes app = Effect.app_def [of _ P mxs Tr _ mpc xt, folded app_def xcpt_app_def appi_def eff_def]


lemma length_cases2:
  assumes "LT. P ([],LT)"
  assumes "l ST LT. P (l#ST,LT)"
  shows "P s"
  by (cases s, cases "fst s") (auto intro!: assms)


lemma length_cases3:
  assumes "LT. P ([],LT)"
  assumes "l LT. P ([l],LT)"
  assumes "l ST LT. P (l#ST,LT)"
  shows "P s"
(*<*)
proof -
  obtain xs LT where s: "s = (xs,LT)" by (cases s)
  show ?thesis
  proof (cases xs)
    case Nil with assms s show ?thesis by simp
  next
    fix l xs' assume "xs = l#xs'"
    with assms s show ?thesis by simp
  qed
qed
(*>*)

lemma length_cases4:
  assumes "LT. P ([],LT)"
  assumes "l LT. P ([l],LT)"
  assumes "l l' LT. P ([l,l'],LT)"
  assumes "l l' ST LT. P (l#l'#ST,LT)"
  shows "P s"
(*<*)
proof -
  obtain xs LT where s: "s = (xs,LT)" by (cases s)
  show ?thesis
  proof (cases xs)
    case Nil with assms s show ?thesis by simp
  next
    fix l xs' assume xs: "xs = l#xs'"
    thus ?thesis
    proof (cases xs')
      case Nil with assms s xs show ?thesis by simp
    next
      fix l' ST assume "xs' = l'#ST"
     with assms s xs show ?thesis by simp
    qed
  qed
qed
(*>*)

text ‹ 
\medskip
simp rules for @{term app}
lemma appNone[simp]: "app i P mxs Tr pc mpc et None = True" 
  by (simp add: app_def)


lemma appLoad[simp]:
"appi (Load idx, P, Tr, mxs, pc, s) = (ST LT. s = (ST,LT)  idx < length LT  LT!idx  Err  length ST < mxs)"
  by (cases s, simp)

lemma appStore[simp]:
"appi (Store idx,P,pc,mxs,Tr,s) = (ts ST LT. s = (ts#ST,LT)  idx < length LT)"
  by (rule length_cases2, auto)

lemma appPush[simp]:
"appi (Push v,P,pc,mxs,Tr,s) =
 (ST LT. s = (ST,LT)  length ST < mxs  typeof v  None)"
  by (cases s, simp)

lemma appGetField[simp]:
"appi (Getfield F C,P,pc,mxs,Tr,s) = 
 ( oT vT ST LT. s = (oT#ST, LT)  
  P  C sees F,NonStatic:vT in C  P  oT  (Class C))"
  by (rule length_cases2 [of _ s]) auto

lemma appGetStatic[simp]:
"appi (Getstatic C F D,P,pc,mxs,Tr,s) = 
 ( vT ST LT. s = (ST, LT)  length ST < mxs  P  C sees F,Static:vT in D)"
  by (rule length_cases2 [of _ s]) auto

lemma appPutField[simp]:
"appi (Putfield F C,P,pc,mxs,Tr,s) = 
 ( vT vT' oT ST LT. s = (vT#oT#ST, LT) 
  P  C sees F,NonStatic:vT' in C  P  oT  (Class C)  P  vT  vT')"
  by (rule length_cases4 [of _ s], auto)

lemma appPutstatic[simp]:
"appi (Putstatic C F D,P,pc,mxs,Tr,s) = 
 ( vT vT' ST LT. s = (vT#ST, LT) 
  P  C sees F,Static:vT' in D  P  vT  vT')"
  by (rule length_cases4 [of _ s], auto)

lemma appNew[simp]:
  "appi (New C,P,pc,mxs,Tr,s) = 
  (ST LT. s=(ST,LT)  is_class P C  length ST < mxs)"
  by (cases s, simp)

lemma appCheckcast[simp]: 
  "appi (Checkcast C,P,pc,mxs,Tr,s) =  
  (T ST LT. s = (T#ST,LT)  is_class P C  is_refT T)"
  by (cases s, cases "fst s", simp add: app_def) (cases "hd (fst s)", auto)

lemma appiPop[simp]: 
"appi (Pop,P,pc,mxs,Tr,s) = (ts ST LT. s = (ts#ST,LT))"
  by (rule length_cases2, auto)

lemma appIAdd[simp]:
"appi (IAdd,P,pc,mxs,Tr,s) = (ST LT. s = (Integer#Integer#ST,LT))"
(*<*)
proof -
  obtain ST LT where [simp]: "s = (ST,LT)" by (cases s)
  have "ST = []  (T. ST = [T])  (T1 T2 ST'. ST = T1#T2#ST')"
    by (cases ST, auto, case_tac list, auto)
  moreover
  { assume "ST = []" hence ?thesis by simp }
  moreover
  { fix T assume "ST = [T]" hence ?thesis by (cases T, auto) }
  moreover
  { fix T1 T2 ST' assume "ST = T1#T2#ST'"
    hence ?thesis by (cases T1, auto)
  }
  ultimately show ?thesis by blast
qed
(*>*)


lemma appIfFalse [simp]:
"appi (IfFalse b,P,pc,mxs,Tr,s) = 
  (ST LT. s = (Boolean#ST,LT)  0  int pc + b)"
(*<*)
  apply (rule length_cases2)
   apply simp
  apply (case_tac l) 
      apply auto
  done
(*>*)

lemma appCmpEq[simp]:
"appi (CmpEq,P,pc,mxs,Tr,s) = 
  (T1 T2 ST LT. s = (T1#T2#ST,LT)  (¬is_refT T1  T2 = T1  is_refT T1  is_refT T2))"
  by (rule length_cases4, auto)

lemma appReturn[simp]:
"appi (Return,P,pc,mxs,Tr,s) = (T ST LT. s = (T#ST,LT)  P  T  Tr)" 
  by (rule length_cases2, auto)

lemma appThrow[simp]:
  "appi (Throw,P,pc,mxs,Tr,s) = (T ST LT. s=(T#ST,LT)  is_refT T)"
  by (rule length_cases2, auto)  

lemma effNone: 
  "(pc', s')  set (eff i P pc et None)  s' = None"
  by (auto simp add: eff_def xcpt_eff_def norm_eff_def)


text ‹ some helpers to make the specification directly executable: ›
lemma relevant_entries_append [simp]:
  "relevant_entries P i pc (xt @ xt') = relevant_entries P i pc xt @ relevant_entries P i pc xt'"
  by (unfold relevant_entries_def) simp

lemma xcpt_app_append [iff]:
  "xcpt_app i P pc mxs (xt@xt') τ = (xcpt_app i P pc mxs xt τ  xcpt_app i P pc mxs xt' τ)"
  by (unfold xcpt_app_def) fastforce

lemma xcpt_eff_append [simp]:
  "xcpt_eff i P pc τ (xt@xt') = xcpt_eff i P pc τ xt @ xcpt_eff i P pc τ xt'"
 by (unfold xcpt_eff_def, cases τ) simp

lemma app_append [simp]:
  "app i P pc T mxs mpc (xt@xt') τ = (app i P pc T mxs mpc xt τ  app i P pc T mxs mpc xt' τ)"
  by (unfold app_def eff_def) auto

end

Theory EffectMono

(*  Title:      JinjaDCI/BV/EffMono.thy

    Author:     Gerwin Klein, Susannah Mansky
    Copyright   2000 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory BV/EffectMono.thy by Gerwin Klein
*)

section ‹ Monotonicity of eff and app ›

theory EffectMono imports Effect begin

declare not_Err_eq [iff]

lemma appi_mono: 
  assumes wf: "wf_prog p P"
  assumes less: "P  τ i τ'"
  shows "appi (i,P,mxs,mpc,rT,τ')  appi (i,P,mxs,mpc,rT,τ)"
(*<*)
proof -
  assume app: "appi (i,P,mxs,mpc,rT,τ')"
  
  obtain ST LT ST' LT' where
    [simp]: "τ = (ST,LT)" and
    [simp]: "τ' = (ST',LT')" 
    by (cases τ, cases τ')

  from less have [simp]: "size ST = size ST'" and [simp]: "size LT = size LT'"
    by (auto dest: list_all2_lengthD)

  note [iff] = list_all2_Cons2 widen_Class  
  note [simp] = fun_of_def 

  from app less show "appi (i,P,mxs,mpc,rT,τ)"
  proof (cases i)
    case Load
    with app less show ?thesis by (auto dest!: list_all2_nthD)
  next
    case (Invoke M n)
    with app have n: "n < size ST'" by simp
    
    { assume "ST!n = NT" hence ?thesis using n app Invoke by simp }
    moreover {
      assume "ST'!n = NT"
      moreover with n less have "ST!n = NT" 
        by (auto dest: list_all2_nthD)
      ultimately have ?thesis using n app Invoke by simp
    }
    moreover {
      assume ST: "ST!n  NT" and ST': "ST'!n  NT" 

      from ST' app Invoke obtain D Ts T m C' where
        D:   "ST' ! n = Class D" and
        Ts:  "P  rev (take n ST') [≤] Ts" and
        D_M: "P  D sees M,NonStatic: TsT = m in C'"
        by auto

      from n D less have "P  ST!n  ST'!n" 
        by (fastforce dest: list_all2_nthD2)
      with D ST obtain D' where
        D': "ST!n = Class D'" and DsubC: "P  D' * D" by auto

      from wf D_M DsubC obtain Ts' T' m' C'' where
        D'_M: "P  D' sees M,NonStatic: Ts'T' = m' in C''" and
        Ts': "P  Ts [≤] Ts'"
        by (blast dest: sees_method_mono) 

      from less have "P  rev (take n ST) [≤] rev (take n ST')" by simp
      also note Ts also note Ts' 
      finally have "P  rev (take n ST) [≤] Ts'" .
      with D'_M D' app less Invoke have ?thesis by fastforce
    }
    ultimately show ?thesis by blast
  next
    case (Invokestatic D M n)
    moreover {
      from app Invokestatic obtain Ts T m C' where
        Ts:  "P  rev (take n ST') [≤] Ts" and
        D_M: "P  D sees M,Static: TsT = m in C'"
        by auto
      from wf D_M obtain Ts' T' m' C'' where
        D'_M: "P  D sees M,Static: Ts'T' = m' in C''" and
        Ts': "P  Ts [≤] Ts'"
        by (blast dest: sees_method_mono) 
      from less have "P  rev (take n ST) [≤] rev (take n ST')" by simp
      also note Ts also note Ts' 
      finally have "P  rev (take n ST) [≤] Ts'" .
      with D'_M app less Invokestatic have ?thesis by fastforce
    }
    ultimately show ?thesis by blast
  next 
    case Getfield
    with app less show ?thesis by (fastforce intro: rtrancl_trans)
  next
    case (Putfield F C)
    with app less show ?thesis by (fastforce intro: widen_trans rtrancl_trans)
  next
    case (Putstatic C F D)
    with app less show ?thesis by (fastforce intro: widen_trans rtrancl_trans)
  next
    case Return
    with app less show ?thesis by (fastforce intro: widen_trans)
  qed (auto elim!: refTE not_refTE)
qed
(*>*)

lemma succs_mono:
  assumes wf: "wf_prog p P" and appi: "appi (i,P,mxs,mpc,rT,τ')"
  shows "P  τ i τ'  set (succs i τ pc)  set (succs i τ' pc)"
(*<*)
proof (cases i)
  case (Invoke M n)
  obtain ST LT ST' LT' where 
    [simp]: "τ = (ST,LT)" and [simp]: "τ' = (ST',LT')" by (cases τ, cases τ') 
  assume "P  τ i τ'"
  moreover
  with appi Invoke have "n < size ST" by (auto dest: list_all2_lengthD)
  ultimately
  have "P  ST!n  ST'!n" by (auto simp add: fun_of_def dest: list_all2_nthD)
  with Invoke show ?thesis by auto 
qed auto
(*>*)
  

lemma app_mono: 
  assumes wf: "wf_prog p P"
  assumes less': "P  τ ≤' τ'"
  shows "app i P m rT pc mpc xt τ'  app i P m rT pc mpc xt τ"
(*<*)
proof (cases τ)
  case None thus ?thesis by simp
next
  case (Some τ1) 
  moreover
  with less' obtain τ2 where τ2: "τ' = Some τ2" by (cases τ') auto
  ultimately have less: "P  τ1 i τ2" using less' by simp
  
  assume "app i P m rT pc mpc xt τ'"
  with Some τ2 obtain
    appi: "appi (i, P, pc, m, rT, τ2)" and
    xcpt: "xcpt_app i P pc m xt τ2" and
    succs: "(pc',s')set (eff i P pc xt (Some τ2)). pc' < mpc"
    by (auto simp add: app_def)
  
  from wf less appi have "appi (i, P, pc, m, rT, τ1)" by (rule appi_mono)
  moreover
  from less have "size (fst τ1) = size (fst τ2)" 
    by (cases τ1, cases τ2) (auto dest: list_all2_lengthD)
  with xcpt have "xcpt_app i P pc m xt τ1" by (simp add: xcpt_app_def)
  moreover
  from wf appi less have "pc. set (succs i τ1 pc)  set (succs i τ2 pc)"
    by (blast dest: succs_mono)
  with succs
  have "(pc',s')set (eff i P pc xt (Some τ1)). pc' < mpc"
    by (cases τ1, cases τ2)
       (auto simp add: eff_def norm_eff_def xcpt_eff_def dest: bspec)
  ultimately
  show ?thesis using Some by (simp add: app_def)
qed
(*>*)


lemma effi_mono:
  assumes wf: "wf_prog p P"
  assumes less: "P  τ i τ'"
  assumes appi: "app i P m rT pc mpc xt (Some τ')"
  assumes succs: "succs i τ pc  []"  "succs i τ' pc  []"
  shows "P  effi (i,P,τ) i effi (i,P,τ')"
(*<*)
proof -
  obtain ST LT ST' LT' where
    [simp]: "τ = (ST,LT)" and
    [simp]: "τ' = (ST',LT')" 
    by (cases τ, cases τ')
  
  note [simp] = eff_def app_def fun_of_def 

  from less have "P  (Some τ) ≤' (Some τ')" by simp
  from wf this appi 
  have app: "app i P m rT pc mpc xt (Some τ)" by (rule app_mono)

  from less app appi show ?thesis
  proof (cases i)
    case Throw with succs have False by simp
    thus ?thesis ..
  next
    case Return with succs have False by simp
    thus ?thesis ..
  next
    case (Load i)
    from Load app obtain y where
       y:  "i < size LT" "LT!i = OK y" by clarsimp
    from Load appi obtain y' where
       y': "i < size LT'" "LT'!i = OK y'" by clarsimp

    from less have "P  LT [≤] LT'" by simp
    with y y' have "P  y  y'" by (auto dest: list_all2_nthD)    
    with Load less y y' app appi
    show ?thesis by auto
  next
    case Store with less app appi
    show ?thesis by (auto simp add: list_all2_update_cong) 
  next
    case (Invoke M n) 
    with appi have n: "n < size ST'" by simp
    from less have [simp]: "size ST = size ST'" 
      by (auto dest: list_all2_lengthD)

    from Invoke succs have ST: "ST!n  NT" and ST': "ST'!n  NT"
      by (auto split: if_split_asm)
    
    from ST' appi Invoke obtain D Ts T m C' where
      D:   "ST' ! n = Class D" and
      D_M: "P  D sees M,NonStatic: TsT = m in C'"
      by auto

    from n D less have "P  ST!n  ST'!n" 
      by (fastforce dest: list_all2_nthD2)
    with D ST obtain D' where
      D': "ST ! n = Class D'" and DsubC: "P  D' * D"
      by (auto simp: widen_Class)
      
    from wf D_M DsubC obtain Ts' T' m' C'' where
      D'_M: "P  D' sees M,NonStatic: Ts'T' = m' in C''" and
      Ts': "P  T'  T"
      by (blast dest: sees_method_mono) 

    with Invoke n D D' D_M less 
    show ?thesis by (auto intro: list_all2_dropI)
  qed auto
qed
(*>*)

end

Theory BVSpec

(*  Title:      JinjaDCI/BV/BVSpec.thy

    Author:     Cornelia Pusch, Gerwin Klein, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory BV/BVSpec.thy by Tobias Nipkow
*)

section ‹ The Bytecode Verifier \label{sec:BVSpec} ›

theory BVSpec
imports Effect
begin

text ‹
  This theory contains a specification of the BV. The specification
  describes correct typings of method bodies; it corresponds 
  to type \emph{checking}.
›


definition
  ― ‹The method type only contains declared classes:›
  check_types :: "'m prog  nat  nat  tyi' err list  bool"
where 
  "check_types P mxs mxl τs  set τs  states P mxs mxl"

  ― ‹An instruction is welltyped if it is applicable and its effect›
  ― ‹is compatible with the type at all successor instructions:›
definition
  wt_instr :: "['m prog,ty,nat,pc,ex_table,instr,pc,tym]  bool"
  ("_,_,_,_,_  _,_ :: _" [60,0,0,0,0,0,0,61] 60)
where
  "P,T,mxs,mpc,xt  i,pc :: τs 
  app i P mxs T pc mpc xt (τs!pc)  
  ((pc',τ')  set (eff i P pc xt (τs!pc)). P  τ' ≤' τs!pc')"

  ― ‹The type at @{text "pc=0"} conforms to the method calling convention:›
definition wt_start :: "['m prog,cname,staticb,ty list,nat,tym]  bool"
where
  "wt_start P C b Ts mxl0 τs 
case b of NonStatic  P  Some ([],OK (Class C)#map OK Ts@replicate mxl0 Err) ≤' τs!0
        | Static   P  Some ([],map OK Ts@replicate mxl0 Err) ≤' τs!0"

  ― ‹A method is welltyped if the body is not empty,›
  ― ‹if the method type covers all instructions and mentions›
  ― ‹declared classes only, if the method calling convention is respected, and›
  ― ‹if all instructions are welltyped.›
definition wt_method :: "['m prog,cname,staticb,ty list,ty,nat,nat,instr list,
                 ex_table,tym]  bool"
where
  "wt_method P C b Ts Tr mxs mxl0 is xt τs 
  0 < size is  size τs = size is 
  check_types P mxs ((case b of Static  0 | NonStatic  1)+size Ts+mxl0) (map OK τs) 
  wt_start P C b Ts mxl0 τs 
  (pc < size is. P,Tr,mxs,size is,xt  is!pc,pc :: τs)"

  ― ‹A program is welltyped if it is wellformed and all methods are welltyped›
definition  wf_jvm_prog_phi :: "tyP  jvm_prog  bool" ("wf'_jvm'_prog⇘_")
where
  "wf_jvm_progΦ 
    wf_prog (λP C (M,b,Ts,Tr,(mxs,mxl0,is,xt)). 
      wt_method P C b Ts Tr mxs mxl0 is xt (Φ C M))"

definition wf_jvm_prog :: "jvm_prog  bool"
where
  "wf_jvm_prog P  Φ. wf_jvm_progΦ P"

lemma wt_jvm_progD:
  "wf_jvm_progΦ P  wt. wf_prog wt P"
(*<*) by (unfold wf_jvm_prog_phi_def, blast) (*>*)

lemma wt_jvm_prog_impl_wt_instr:
  " wf_jvm_progΦ P; 
      P  C sees M,b:Ts  T = (mxs,mxl0,ins,xt) in C; pc < size ins  
   P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
(*<*)
  apply (unfold wf_jvm_prog_phi_def)
  apply (drule (1) sees_wf_mdecl)
  apply (simp add: wf_mdecl_def wt_method_def)
  done
(*>*)

lemma wt_jvm_prog_impl_wt_start:
  " wf_jvm_progΦ P; 
     P  C sees M,b:Ts  T = (mxs,mxl0,ins,xt) in C   
  0 < size ins  wt_start P C b Ts mxl0 (Φ C M)"
(*<*)
  apply (unfold wf_jvm_prog_phi_def)
  apply (drule (1) sees_wf_mdecl)
  apply (simp add: wf_mdecl_def wt_method_def)
  done
(*>*)

lemma wf_jvm_prog_nclinit:
assumes wtp: "wf_jvm_progΦ P"
  and meth:  "P  C sees M, b :  TsT = (mxs, mxl0, ins, xt) in D"
  and wt:    "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  and pc:    "pc < length ins" and Φ: "Φ C M ! pc = Some(ST,LT)"
  and ins:   "ins ! pc = Invokestatic C0 M0 n"
shows "M0  clinit"
 using assms by(simp add: wf_jvm_prog_phi_def wt_instr_def app_def)

end

Theory TF_JVM

(*  Title:      JinjaDCI/BV/TF_JVM.thy

    Author:     Tobias Nipkow, Gerwin Klein, Susannah Mansky
    Copyright   2000 TUM, 2019-20 UIUC

    Based on the Jinja theory BV/TF_JVM.thy by Tobias Nipkow and Gerwin Klein
*)

section ‹ The Typing Framework for the JVM \label{sec:JVM} ›

theory TF_JVM
imports Jinja.Typing_Framework_err EffectMono BVSpec
begin

definition exec :: "jvm_prog  nat  ty  ex_table  instr list  tyi' err step_type"
where 
  "exec G maxs rT et bs 
  err_step (size bs) (λpc. app (bs!pc) G maxs rT pc (size bs) et) 
                     (λpc. eff (bs!pc) G pc et)"

locale JVM_sl =
  fixes P :: jvm_prog and mxs and mxl0
  fixes b and Ts :: "ty list" and "is" and xt and Tr

  fixes mxl and A and r and f and app and eff and step
  defines [simp]: "mxl  (case b of Static  0 | NonStatic  1)+size Ts+mxl0"
  defines [simp]: "A    states P mxs mxl"
  defines [simp]: "r    JVM_SemiType.le P mxs mxl"
  defines [simp]: "f    JVM_SemiType.sup P mxs mxl"

  defines [simp]: "app  λpc. Effect.app (is!pc) P mxs Tr pc (size is) xt"
  defines [simp]: "eff  λpc. Effect.eff (is!pc) P pc xt"
  defines [simp]: "step  err_step (size is) app eff"


locale start_context = JVM_sl +
  fixes p and C
  assumes wf: "wf_prog p P"
  assumes C:  "is_class P C"
  assumes Ts: "set Ts  types P"

  fixes first :: tyi' and start
  defines [simp]: 
  "first  Some ([],(case b of Static  [] | NonStatic  [OK (Class C)]) @ map OK Ts @ replicate mxl0 Err)"
  defines [simp]:
  "start  (OK first) #  replicate (size is - 1) (OK None)"



subsection ‹ Connecting JVM and Framework ›


lemma (in JVM_sl) step_def_exec: "step  exec P mxs Tr xt is" 
  by (simp add: exec_def)  

lemma special_ex_swap_lemma [iff]: 
  "(? X. (? n. X = A n & P n) & Q X) = (? n. Q(A n) & P n)"
  by blast

lemma ex_in_list [iff]:
  "(n. ST  list n A  n  mxs) = (set ST  A  size ST  mxs)"
  by (unfold list_def) auto

lemma singleton_list: 
  "(n. [Class C]  list n (types P)  n  mxs) = (is_class P C  0 < mxs)"
  by auto

lemma set_drop_subset:
  "set xs  A  set (drop n xs)  A"
  by (auto dest: in_set_dropD)

lemma Suc_minus_minus_le:
  "n < mxs  Suc (n - (n - b))  mxs"
  by arith

lemma in_listE:
  " xs  list n A; size xs = n; set xs  A  P   P"
  by (unfold list_def) blast

declare is_relevant_entry_def [simp]
declare set_drop_subset [simp]

theorem (in start_context) exec_pres_type:
  "pres_type step (size is) A"
(*<*)
  apply (insert wf)
  apply simp
  apply (unfold JVM_states_unfold)
  apply (rule pres_type_lift)
  apply clarify
  apply (rename_tac s pc pc' s')
  apply (case_tac s)
   apply simp
   apply (drule effNone)
   apply simp  
  apply (simp add: Effect.app_def xcpt_app_def Effect.eff_def  
                   xcpt_eff_def norm_eff_def relevant_entries_def)
  apply (case_tac "is!pc")

  ― ‹Load›
  apply clarsimp
  apply (frule listE_nth_in, assumption)
  apply fastforce

  ― ‹Store›
  apply fastforce

  ― ‹Push›
  apply (fastforce simp add: typeof_lit_is_type)

  ― ‹New›
  apply fastforce

  ― ‹Getfield›
  apply (fastforce dest: sees_field_is_type)

  ― ‹Getstatic›
  apply (fastforce dest: sees_field_is_type)

  ― ‹Putfield›
  apply fastforce

  ― ‹Putstatic›
  apply fastforce

  ― ‹Checkcast›
  apply fastforce

  defer defer ― ‹Invoke and Invokestatic deferred›
  
  ― ‹Return›
  apply fastforce

  ― ‹Pop›
  apply fastforce

  ― ‹IAdd›
  apply fastforce
  
  ― ‹Goto›
  apply fastforce

  ― ‹CmpEq›
  apply fastforce

  ― ‹IfFalse›
  apply fastforce

  ― ‹Throw›
  apply fastforce

  ― ‹Invoke›
  apply (clarsimp split!: if_splits)
   apply fastforce
  apply (erule disjE)
   prefer 2
   apply fastforce
  apply clarsimp
  apply (rule conjI)
   apply (drule (1) sees_wf_mdecl)
   apply (clarsimp simp add: wf_mdecl_def)
  apply arith

  ― ‹Invokestatic›
  apply (clarsimp split!: if_splits)
  apply (erule disjE)
   prefer 2
   apply fastforce
  apply clarsimp
  apply (drule (1) sees_wf_mdecl)
  apply (clarsimp simp add: wf_mdecl_def)
  done
(*>*)

declare is_relevant_entry_def [simp del]
declare set_drop_subset [simp del]

lemma lesubstep_type_simple:
  "xs [⊑Product.le (=) r] ys  set xs {⊑r} set ys"
(*<*)
  apply (unfold lesubstep_type_def)
  apply clarify
  apply (simp add: set_conv_nth)
  apply clarify
  apply (drule le_listD, assumption)
  apply (clarsimp simp add: lesub_def Product.le_def)
  apply (rule exI)
  apply (rule conjI)
   apply (rule exI)
   apply (rule conjI)
    apply (rule sym)
    apply assumption
   apply assumption
  apply assumption
  done
(*>*)

declare is_relevant_entry_def [simp del]


lemma conjI2: " A; A  B   A  B" by blast
  
lemma (in JVM_sl) eff_mono:
  "wf_prog p P; pc < length is; ssup_state_opt P t; app pc t
   set (eff pc s) {⊑sup_state_opt P} set (eff pc t)"
(*<*)
  apply simp
  apply (unfold Effect.eff_def)  
  apply (cases t)
   apply (simp add: lesub_def)
  apply (rename_tac a)
  apply (cases s)
   apply simp
  apply (rename_tac b)
  apply simp
  apply (rule lesubstep_union)
   prefer 2
   apply (rule lesubstep_type_simple)
   apply (simp add: xcpt_eff_def)
   apply (rule le_listI)
    apply (simp add: split_beta)
   apply (simp add: split_beta)
   apply (simp add: lesub_def fun_of_def)
   apply (case_tac a)
   apply (case_tac b)
   apply simp   
   apply (subgoal_tac "size ab = size aa")
     prefer 2
     apply (clarsimp simp add: list_all2_lengthD)
   apply simp
  apply (clarsimp simp add: norm_eff_def lesubstep_type_def lesub_def iff del: sup_state_conv)
  apply (rule exI)
  apply (rule conjI2)
   apply (rule imageI)
   apply (clarsimp simp add: Effect.app_def iff del: sup_state_conv)
   apply (drule (2) succs_mono)
   apply blast
  apply simp
  apply (erule effi_mono)
     apply simp
    apply assumption   
   apply clarsimp
  apply clarsimp  
  done
(*>*)

lemma (in JVM_sl) bounded_step: "bounded step (size is)"
(*<*)
  apply simp
  apply (unfold bounded_def err_step_def Effect.app_def Effect.eff_def)
  apply (auto simp add: error_def map_snd_def split: err.splits option.splits)
  done
(*>*)

theorem (in JVM_sl) step_mono:
  "wf_prog wf_mb P  mono r step (size is) A"
(*<*)
  apply (simp add: JVM_le_Err_conv)  
  apply (insert bounded_step)
  apply (unfold JVM_states_unfold)
  apply (rule mono_lift)
     apply blast
    apply (unfold app_mono_def lesub_def)
    apply clarsimp
    apply (erule (2) app_mono)
   apply simp
  apply clarify
  apply (drule eff_mono)
     apply (auto simp add: lesub_def)
  done
(*>*)


lemma (in start_context) first_in_A [iff]: "OK first  A"
  using Ts C by (cases b; force intro!: list_appendI simp add: JVM_states_unfold)


lemma (in JVM_sl) wt_method_def2:
  "wt_method P C' b Ts Tr mxs mxl0 is xt τs =
  (is  []  
   size τs = size is 
   OK ` set τs  states P mxs mxl 
   wt_start P C' b Ts mxl0 τs  
   wt_app_eff (sup_state_opt P) app eff τs)"
(*<*)
  apply (unfold wt_method_def wt_app_eff_def wt_instr_def lesub_def check_types_def)
  apply auto
  done
(*>*)


end

Theory BVExec

(*  Title:      JinjaDCI/BV/BVExec.thy

    Author:     Tobias Nipkow, Gerwin Klein, Susannah Mansky
    Copyright   2000 TUM, 2020 UIUC

    Based on the Jinja theory BV/BVExec.thy by Tobias Nipkow and Gerwin Klein
*)

section ‹ Kildall for the JVM \label{sec:JVM} ›

theory BVExec
imports Jinja.Abstract_BV TF_JVM
begin

definition kiljvm :: "jvm_prog  nat  nat  ty  
             instr list  ex_table  tyi' err list  tyi' err list"
where
  "kiljvm P mxs mxl Tr is xt 
  kildall (JVM_SemiType.le P mxs mxl) (JVM_SemiType.sup P mxs mxl) 
          (exec P mxs Tr xt is)"

definition wt_kildall :: "jvm_prog  cname  staticb  ty list  ty  nat  nat  
                 instr list  ex_table  bool"
where
  "wt_kildall P C' b Ts Tr mxs mxl0 is xt 
   0 < size is  
   (let first  = Some ([],(case b of Static  [] | NonStatic  [OK (Class C')])
                            @(map OK Ts)@(replicate mxl0 Err));
        start  = (OK first)#(replicate (size is - 1) (OK None));
        result = kiljvm P mxs
                   ((case b of Static  0 | NonStatic  1)+size Ts+mxl0)
                     Tr is xt start
    in n < size is. result!n  Err)"

definition wf_jvm_progk :: "jvm_prog  bool"
where
  "wf_jvm_progk P 
  wf_prog (λP C' (M,b,Ts,Tr,(mxs,mxl0,is,xt)). wt_kildall P C' b Ts Tr mxs mxl0 is xt) P"


theorem (in start_context) is_bcv_kiljvm:
  "is_bcv r Err step (size is) A (kiljvm P mxs mxl Tr is xt)"
(*<*)
  apply (insert wf)
  apply (unfold kiljvm_def)
  apply (fold r_def f_def step_def_exec)
  apply (rule is_bcv_kildall)
       apply simp apply (rule Semilat.intro)
       apply (fold sl_def2)
       apply (erule semilat_JVM)
      apply simp
      apply blast
     apply (simp add: JVM_le_unfold)
    apply (rule exec_pres_type)
   apply (rule bounded_step)
  apply (erule step_mono)
  done
(*>*)

(* FIXME: move? *)
lemma subset_replicate [intro?]: "set (replicate n x)  {x}"
  by (induct n) auto

lemma in_set_replicate:
  assumes "x  set (replicate n y)"
  shows "x = y"
(*<*)
proof -
  note assms
  also have "set (replicate n y)  {y}" ..
  finally show ?thesis by simp
qed
(*>*)

lemma (in start_context) start_in_A [intro?]:
  "0 < size is  start  list (size is) A"
  using Ts C
(*<*)
  apply (simp add: JVM_states_unfold)
  apply (cases b; force intro!: listI list_appendI dest!: in_set_replicate)
  done
(*>*)


theorem (in start_context) wt_kil_correct:
  assumes wtk: "wt_kildall P C b Ts Tr mxs mxl0 is xt"
  shows "τs. wt_method P C b Ts Tr mxs mxl0 is xt τs"
(*<*)
proof -
  from wtk obtain res where    
    result:   "res = kiljvm P mxs mxl Tr is xt start" and
    success:  "n < size is. res!n  Err" and
    instrs:   "0 < size is" 
    by (unfold wt_kildall_def) simp
      
  have bcv: "is_bcv r Err step (size is) A (kiljvm P mxs mxl Tr is xt)"
    by (rule is_bcv_kiljvm)
    
  from instrs have "start  list (size is) A" ..
  with bcv success result have 
    "tslist (size is) A. start [⊑⇩r] ts  wt_step r Err step ts"
    by (unfold is_bcv_def) blast
  then obtain τs' where
    in_A: "τs'  list (size is) A" and
    s:    "start [⊑⇩r] τs'" and
    w:    "wt_step r Err step τs'"
    by blast
  hence wt_err_step: "wt_err_step (sup_state_opt P) step τs'"
    by (simp add: wt_err_step_def JVM_le_Err_conv)

  from in_A have l: "size τs' = size is" by simp  
  moreover {
    from in_A  have "check_types P mxs mxl τs'" by (simp add: check_types_def)
    also from w have "x  set τs'. x  Err" 
      by (auto simp add: wt_step_def all_set_conv_all_nth)
    hence [symmetric]: "map OK (map ok_val τs') = τs'" 
      by (auto intro!: map_idI simp add: wt_step_def)
    finally  have "check_types P mxs mxl (map OK (map ok_val τs'))" .
  } 
  moreover {  
    from s have "start!0 ⊑⇩r τs'!0" by (rule le_listD) simp
    moreover
    from instrs w l 
    have "τs'!0  Err" by (unfold wt_step_def) simp
    then obtain τs0 where "τs'!0 = OK τs0" by auto
    ultimately
    have "wt_start P C b Ts mxl0 (map ok_val τs')" using l instrs
      by (unfold wt_start_def) 
         (cases b; simp add: lesub_def JVM_le_Err_conv Err.le_def)
  }
  moreover 
  from in_A have "set τs'  A" by simp  
  with wt_err_step bounded_step
  have "wt_app_eff (sup_state_opt P) app eff (map ok_val τs')"
    by (auto intro: wt_err_imp_wt_app_eff simp add: l)
  ultimately
  have "wt_method P C b Ts Tr mxs mxl0 is xt (map ok_val τs')"
    using instrs by (simp add: wt_method_def2 check_types_def del: map_map)
  thus ?thesis by blast
qed
(*>*)


theorem (in start_context) wt_kil_complete:
  assumes wtm: "wt_method P C b Ts Tr mxs mxl0 is xt τs"
  shows "wt_kildall P C b Ts Tr mxs mxl0 is xt"
(*<*)
proof -
  from wtm obtain
    instrs:   "0 < size is" and
    length:   "length τs = length is" and 
    ck_type:  "check_types P mxs mxl (map OK τs)" and
    wt_start: "wt_start P C b Ts mxl0 τs" and
    app_eff:  "wt_app_eff (sup_state_opt P) app eff τs"
    by (simp add: wt_method_def2 check_types_def)

  from ck_type
  have in_A: "set (map OK τs)  A" 
    by (simp add: check_types_def)  
  with app_eff in_A bounded_step
  have "wt_err_step (sup_state_opt P) (err_step (size τs) app eff) (map OK τs)"
    by - (erule wt_app_eff_imp_wt_err,
          auto simp add: exec_def length states_def)
  hence wt_err: "wt_err_step (sup_state_opt P) step (map OK τs)" 
    by (simp add: length)
  have is_bcv: "is_bcv r Err step (size is) A (kiljvm P mxs mxl Tr is xt)"
    by (rule is_bcv_kiljvm)
  moreover from instrs have "start  list (size is) A" ..
  moreover
  let ?τs = "map OK τs"  
  have less_τs: "start [⊑⇩r] ?τs"
  proof (rule le_listI)
    from length instrs
    show "length start = length (map OK τs)" by simp
  next
    fix n
    from wt_start have "P  ok_val (start!0) ≤' τs!0" 
      by (cases b; simp add: wt_start_def)
    moreover from instrs length have "0 < length τs" by simp
    ultimately have "start!0 ⊑⇩r ?τs!0" 
      by (simp add: JVM_le_Err_conv lesub_def)
    moreover {
      fix n'
      have "OK None ⊑⇩r ?τs!n"
        by (auto simp add: JVM_le_Err_conv Err.le_def lesub_def 
                 split: err.splits)
      hence "n = Suc n'; n < size start  start!n ⊑⇩r ?τs!n" by simp
    }
    ultimately
    show "n < size start  start!n ⊑⇩r ?τs!n" by (cases n, blast+)   
  qed
  moreover
  from ck_type length
  have "?τs  list (size is) A"
    by (auto intro!: listI simp add: check_types_def)
  moreover
  from wt_err have "wt_step r Err step ?τs" 
    by (simp add: wt_err_step_def JVM_le_Err_conv)
  ultimately
  have "p. p < size is  kiljvm P  mxs mxl Tr is xt start ! p  Err" 
    by (unfold is_bcv_def) blast
  with instrs 
  show "wt_kildall P C b Ts Tr mxs mxl0 is xt" by (unfold wt_kildall_def) simp
qed
(*>*)


theorem jvm_kildall_correct:
  "wf_jvm_progk P = wf_jvm_prog P"
(*<*)
proof 
  let  = "λC M. let (C,b,Ts,Tr,(mxs,mxl0,is,xt)) = method P C M in 
              SOME τs. wt_method P C b Ts Tr mxs mxl0 is xt τs"

  ― ‹soundness›
  assume wt: "wf_jvm_progk P"
  hence "wf_jvm_prog P"
    apply (unfold wf_jvm_prog_phi_def wf_jvm_progk_def)    
    apply (erule wf_prog_lift)
    apply (auto dest!: start_context.wt_kil_correct [OF start_context.intro] 
                intro: someI)
    apply (erule sees_method_is_class)
    done
  thus "wf_jvm_prog P" by (unfold wf_jvm_prog_def) fast
next
  ― ‹completeness›
  assume wt: "wf_jvm_prog P"
  thus "wf_jvm_progk P"
    apply (unfold wf_jvm_prog_def wf_jvm_prog_phi_def wf_jvm_progk_def)
    apply (clarify)
    apply (erule wf_prog_lift)
    apply (auto intro!: start_context.wt_kil_complete start_context.intro)
    apply (erule sees_method_is_class)
    done
qed
(*>*)

end

Theory LBVJVM

(*  Title:      JinjaDCI/BV/LBVJVM.thy

    Author:     Tobias Nipkow, Gerwin Klein, Susannah Mansky
    Copyright   2000 TUM, 2020 UIUC

    Based on the Jinja theory BV/LBVJVM.thy by Tobias Nipkow and Gerwin Klein
*)

section ‹ LBV for the JVM \label{sec:JVM} ›

theory LBVJVM
imports Jinja.Abstract_BV TF_JVM
begin

type_synonym prog_cert = "cname  mname  tyi' err list"

definition check_cert :: "jvm_prog  nat  nat  nat  tyi' err list  bool"
where
  "check_cert P mxs mxl n cert  check_types P mxs mxl cert  size cert = n+1 
                                 (i<n. cert!i  Err)  cert!n = OK None"

definition lbvjvm :: "jvm_prog  nat  nat  ty  ex_table  
             tyi' err list  instr list  tyi' err  tyi' err"
where
  "lbvjvm P mxs maxr Tr et cert bs 
  wtl_inst_list bs cert (JVM_SemiType.sup P mxs maxr) (JVM_SemiType.le P mxs maxr) Err (OK None) (exec P mxs Tr et bs) 0"

definition wt_lbv :: "jvm_prog  cname  staticb  ty list  ty  nat  nat  
             ex_table  tyi' err list  instr list  bool"
where
  "wt_lbv P C b Ts Tr mxs mxl0 et cert ins 
   check_cert P mxs ((case b of Static  0 | NonStatic  1)+size Ts+mxl0) (size ins) cert 
   0 < size ins  
   (let start  = Some ([],(case b of Static  [] | NonStatic  [OK (Class C)])
                            @((map OK Ts))@(replicate mxl0 Err));
        result = lbvjvm P mxs ((case b of Static  0 | NonStatic  1)+size Ts+mxl0) Tr et cert ins (OK start)
    in result  Err)"

definition wt_jvm_prog_lbv :: "jvm_prog  prog_cert  bool"
where
  "wt_jvm_prog_lbv P cert 
  wf_prog (λP C (mn,b,Ts,Tr,(mxs,mxl0,ins,et)). wt_lbv P C b Ts Tr mxs mxl0 et (cert C mn) ins) P"

definition mk_cert :: "jvm_prog  nat  ty  ex_table  instr list 
               tym  tyi' err list"
where
  "mk_cert P mxs Tr et bs phi  make_cert (exec P mxs Tr et bs) (map OK phi) (OK None)"

definition prg_cert :: "jvm_prog  tyP  prog_cert"
where
  "prg_cert P phi C mn  let (C,b,Ts,Tr,(mxs,mxl0,ins,et)) = method P C mn
                         in  mk_cert P mxs Tr et ins (phi C mn)"
   
lemma check_certD [intro?]:
  "check_cert P mxs mxl n cert  cert_ok cert n Err (OK None) (states P mxs mxl)"
  by (unfold cert_ok_def check_cert_def check_types_def) auto


lemma (in start_context) wt_lbv_wt_step:
  assumes lbv: "wt_lbv P C b Ts Tr mxs mxl0 xt cert is"
  shows "τs  list (size is) A. wt_step r Err step τs  OK first ⊑⇩r τs!0"
(*<*)
proof -
  from wf have "semilat (JVM_SemiType.sl P mxs mxl)" ..
  hence "semilat (A, r, f)" by (simp add: sl_def2)
  moreover have "top r Err" by (simp add: JVM_le_Err_conv)
  moreover have "Err  A" by (simp add: JVM_states_unfold)
  moreover have "bottom r (OK None)" 
    by (simp add: JVM_le_Err_conv bottom_def lesub_def Err.le_def split: err.split)
  moreover have "OK None  A" by (simp add: JVM_states_unfold)
  moreover note bounded_step
  moreover from lbv have "cert_ok cert (size is) Err (OK None) A"
    by (unfold wt_lbv_def) (auto dest: check_certD)
  moreover note exec_pres_type
  moreover
  from lbv 
  have "wtl_inst_list is cert f r Err (OK None) step 0 (OK first)  Err"
    by (cases b; simp add: wt_lbv_def lbvjvm_def step_def_exec [symmetric])
  moreover note first_in_A
  moreover from lbv have "0 < size is" by (simp add: wt_lbv_def)
  ultimately show ?thesis by (rule lbvs.wtl_sound_strong [OF lbvs.intro, OF lbv.intro lbvs_axioms.intro, OF Semilat.intro lbv_axioms.intro])
qed
(*>*)


lemma (in start_context) wt_lbv_wt_method:
  assumes lbv: "wt_lbv P C b Ts Tr mxs mxl0 xt cert is"  
  shows "τs. wt_method P C b Ts Tr mxs mxl0 is xt τs"
(*<*)
proof -
  from lbv have l: "is  []" by (simp add: wt_lbv_def)
  moreover
  from wf lbv C Ts obtain τs where 
    list:  "τs  list (size is) A" and
    step:  "wt_step r Err step τs" and    
    start: "OK first ⊑⇩r τs!0" 
    by (blast dest: wt_lbv_wt_step)
  from list have [simp]: "size τs = size is" by simp
  have "size (map ok_val τs) = size is" by simp  
  moreover from l have 0: "0 < size τs" by simp
  with step obtain τs0 where "τs!0 = OK τs0"
    by (unfold wt_step_def) blast
  with start 0 have "wt_start P C b Ts mxl0 (map ok_val τs)"
    by (cases b; simp add: wt_start_def JVM_le_Err_conv lesub_def Err.le_def)    
  moreover {
    from list have "check_types P mxs mxl τs" by (simp add: check_types_def)
    also from step  have "x  set τs. x  Err" 
      by (auto simp add: all_set_conv_all_nth wt_step_def)    
    hence [symmetric]: "map OK (map ok_val τs) = τs"
      by (auto intro!: map_idI)
    finally have "check_types P mxs mxl (map OK (map ok_val τs))" .
  }
  moreover {  
    note bounded_step
    moreover from list have "set τs  A" by simp
    moreover from step have "wt_err_step (sup_state_opt P) step τs"
      by (simp add: wt_err_step_def JVM_le_Err_conv)
    ultimately have "wt_app_eff (sup_state_opt P) app eff (map ok_val τs)"
      by (auto intro: wt_err_imp_wt_app_eff simp add: exec_def states_def)
  }    
  ultimately have "wt_method P C b Ts Tr mxs mxl0 is xt (map ok_val τs)"
    by (simp add: wt_method_def2 check_types_def del: map_map)
  thus ?thesis ..
qed
(*>*)

  
lemma (in start_context) wt_method_wt_lbv:
  assumes wt: "wt_method P C b Ts Tr mxs mxl0 is xt τs" 
  defines [simp]: "cert  mk_cert P mxs Tr xt is τs"
  
  shows "wt_lbv P C b Ts Tr mxs mxl0 xt cert is" 
(*<*)
proof -
  let ?τs  = "map OK τs"
  let ?cert = "make_cert step ?τs (OK None)"

  from wt obtain 
    0:        "0 < size is" and
    size:     "size is = size ?τs" and
    ck_types: "check_types P mxs mxl ?τs" and
    wt_start: "wt_start P C b Ts mxl0 τs" and
    app_eff:  "wt_app_eff (sup_state_opt P) app eff τs"
    by (force simp add: wt_method_def2 check_types_def) 
  
  from wf have "semilat (JVM_SemiType.sl P mxs mxl)" ..
  hence "semilat (A, r, f)" by (simp add: sl_def2)
  moreover have "top r Err" by (simp add: JVM_le_Err_conv)
  moreover have "Err  A" by (simp add: JVM_states_unfold)
  moreover have "bottom r (OK None)" 
    by (simp add: JVM_le_Err_conv bottom_def lesub_def Err.le_def split: err.split)
  moreover have "OK None  A" by (simp add: JVM_states_unfold)
  moreover from wf have "mono r step (size is) A" by (rule step_mono)
  hence "mono r step (size ?τs) A" by (simp add: size)
  moreover from exec_pres_type 
  have "pres_type step (size ?τs) A" by (simp add: size) 
  moreover
  from ck_types have τs_in_A: "set ?τs  A" by (simp add: check_types_def)
  hence "pc. pc < size ?τs  ?τs!pc  A  ?τs!pc  Err" by auto
  moreover from bounded_step 
  have "bounded step (size ?τs)" by (simp add: size)
  moreover have "OK None  Err" by simp
  moreover from bounded_step size τs_in_A app_eff
  have "wt_err_step (sup_state_opt P) step ?τs"
    by (auto intro: wt_app_eff_imp_wt_err simp add: exec_def states_def)    
  hence "wt_step r Err step ?τs"
    by (simp add: wt_err_step_def JVM_le_Err_conv)
  moreover
  from 0 size have "0 < size τs" by auto
  hence "?τs!0 = OK (τs!0)" by simp
  with wt_start have "OK first ⊑⇩r ?τs!0"
    by (cases b; clarsimp simp add: wt_start_def lesub_def Err.le_def JVM_le_Err_conv)
  moreover note first_in_A
  moreover have "OK first  Err" by simp
  moreover note size 
  ultimately
  have "wtl_inst_list is ?cert f r Err (OK None) step 0 (OK first)  Err"
    by (rule lbvc.wtl_complete [OF lbvc.intro, OF lbv.intro lbvc_axioms.intro, OF Semilat.intro lbv_axioms.intro])
  moreover from 0 size have "τs  []" by auto
  moreover from ck_types have "check_types P mxs mxl ?cert"
    apply (auto simp add: make_cert_def check_types_def JVM_states_unfold)
    apply (subst Ok_in_err [symmetric])
    apply (drule nth_mem)
    apply auto
    done
  moreover note 0 size
  ultimately show ?thesis 
    by (simp add: wt_lbv_def lbvjvm_def mk_cert_def step_def_exec [symmetric]
                  check_cert_def make_cert_def nth_append)
qed  
(*>*)


theorem jvm_lbv_correct:
  "wt_jvm_prog_lbv P Cert  wf_jvm_prog P"
(*<*)
proof -  
  let  = "λC mn. let (C,b,Ts,Tr,(mxs,mxl0,is,xt)) = method P C mn in 
              SOME τs. wt_method P C b Ts Tr mxs mxl0 is xt τs"
    
  assume wt: "wt_jvm_prog_lbv P Cert"
  hence "wf_jvm_prog P"
    apply (unfold wf_jvm_prog_phi_def wt_jvm_prog_lbv_def) 
    apply (erule wf_prog_lift)
    apply (auto dest!: start_context.wt_lbv_wt_method [OF start_context.intro] 
                intro: someI)
    apply (erule sees_method_is_class)
    done
  thus ?thesis by (unfold wf_jvm_prog_def) blast
qed
(*>*)

theorem jvm_lbv_complete:
  assumes wt: "wf_jvm_progΦ P" 
  shows "wt_jvm_prog_lbv P (prg_cert P Φ)"
(*<*)
  using wt
  apply (unfold wf_jvm_prog_phi_def wt_jvm_prog_lbv_def)
  apply (erule wf_prog_lift)
  apply (auto simp add: prg_cert_def 
              intro!: start_context.wt_method_wt_lbv start_context.intro)
  apply (erule sees_method_is_class)                                     
  done
(*>*)

end  

Theory BVConform

(*  Title:      JinjaDCI/BV/BVConform.thy

    Author:     Cornelia Pusch, Gerwin Klein, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory BV/BVConform.thy by Cornelia Pusch and Gerwin Klein

The invariant for the type safety proof.
*)

section ‹ BV Type Safety Invariant ›

theory BVConform
imports BVSpec "../JVM/JVMExec" "../Common/Conform"
begin

subsection @{text "correct_state"} definitions ›

definition confT :: "'c prog  heap  val  ty err  bool" 
    ("_,_  _ :≤ _" [51,51,51,51] 50)
where
  "P,h  v :≤ E  case E of Err  True | OK T  P,h  v :≤ T"

notation (ASCII)
  confT  ("_,_ |- _ :<=T _" [51,51,51,51] 50)

abbreviation
  confTs :: "'c prog  heap  val list  tyl  bool" 
      ("_,_  _ [:≤] _" [51,51,51,51] 50) where
  "P,h  vs [:≤] Ts  list_all2 (confT P h) vs Ts"

notation (ASCII)
  confTs  ("_,_ |- _ [:<=T] _" [51,51,51,51] 50)

fun Called_context :: "jvm_prog  cname  instr  bool" where
"Called_context P C0 (New C') = (C0=C')" |
"Called_context P C0 (Getstatic C F D) =  ((C0=D)  (t. P  C has F,Static:t in D))" |
"Called_context P C0 (Putstatic C F D) = ((C0=D)  (t. P  C has F,Static:t in D))" |
"Called_context P C0 (Invokestatic C M n)
   = (Ts T m D. (C0=D)  P  C sees M,Static:Ts  T = m in D)" |
"Called_context P _ _ = False"

abbreviation Called_set :: "instr set" where
"Called_set  {i. C. i = New C}  {i. C M n. i = Invokestatic C M n}
                  {i. C F D. i = Getstatic C F D}  {i. C F D. i = Putstatic C F D}"

lemma Called_context_Called_set:
 "Called_context P D i  i  Called_set" by(cases i, auto)

fun valid_ics :: "jvm_prog  heap  sheap  cname × mname × pc × init_call_status  bool"
  ("_,_,_ i _" [51,51,51,51] 50) where
"valid_ics P h sh (C,M,pc,Calling C' Cs)
 = (let ins = instrs_of P C M in Called_context P (last (C'#Cs)) (ins!pc)
     is_class P C')" |
"valid_ics P h sh (C,M,pc,Throwing Cs a)
 =(let ins = instrs_of P C M in C1. Called_context P C1 (ins!pc)
     (obj. h a = Some obj))" |
"valid_ics P h sh (C,M,pc,Called Cs)
 = (let ins = instrs_of P C M
    in C1 sobj. Called_context P C1 (ins!pc)  sh C1 = Some sobj)" |
"valid_ics P _ _ _ = True"

definition conf_f  :: "jvm_prog  heap  sheap  tyi  bytecode  frame  bool"
where
  "conf_f P h sh  λ(ST,LT) is (stk,loc,C,M,pc,ics).
  P,h  stk [:≤] ST  P,h  loc [:≤] LT  pc < size is  P,h,sh i (C,M,pc,ics)"

lemma conf_f_def2:
  "conf_f P h sh (ST,LT) is (stk,loc,C,M,pc,ics) 
  P,h  stk [:≤] ST  P,h  loc [:≤] LT  pc < size is  P,h,sh i (C,M,pc,ics)"
  by (simp add: conf_f_def)

primrec conf_fs :: "[jvm_prog,heap,sheap,tyP,cname,mname,nat,ty,frame list]  bool"
where
  "conf_fs P h sh Φ C0 M0 n0 T0 [] = True"
| "conf_fs P h sh Φ C0 M0 n0 T0 (f#frs) =
  (let (stk,loc,C,M,pc,ics) = f in
  (ST LT b Ts T mxs mxl0 is xt.
    Φ C M ! pc = Some (ST,LT)  
    (P  C sees M,b:Ts  T = (mxs,mxl0,is,xt) in C) 
    ((D Ts' T' m D'. M0  clinit  ics = No_ics 
       is!pc = Invoke M0 n0  ST!n0 = Class D 
       P  D sees M0,NonStatic:Ts'  T' = m in D'  P  C0 * D'  P  T0  T') 
     (D Ts' T' m. M0  clinit  ics = No_ics 
       is!pc = Invokestatic D M0 n0 
       P  D sees M0,Static:Ts'  T' = m in C0  P  T0  T') 
     (M0 = clinit  (Cs. ics = Called Cs))) 
    conf_f P h sh (ST, LT) is f  conf_fs P h sh Φ C M (size Ts) T frs))"

fun ics_classes :: "init_call_status  cname list" where
"ics_classes (Calling C Cs) = Cs" |
"ics_classes (Throwing Cs a) = Cs" |
"ics_classes (Called Cs) = Cs" |
"ics_classes _ = []"

fun frame_clinit_classes :: "frame  cname list" where
"frame_clinit_classes (stk,loc,C,M,pc,ics) = (if M=clinit then [C] else []) @ ics_classes ics"

abbreviation clinit_classes :: "frame list  cname list" where
"clinit_classes frs  concat (map frame_clinit_classes frs)"

definition distinct_clinit :: "frame list  bool" where
"distinct_clinit frs  distinct (clinit_classes frs)"

definition conf_clinit :: "jvm_prog  sheap  frame list  bool" where
"conf_clinit P sh frs
    distinct_clinit frs 
      (C  set(clinit_classes frs). is_class P C  (sfs. sh C = Some(sfs, Processing)))"

(*************************)

definition correct_state :: "[jvm_prog,tyP,jvm_state]  bool"  ("_,_  _ "  [61,0,0] 61)
where
  "correct_state P Φ  λ(xp,h,frs,sh).
  case xp of
     None  (case frs of
             []  True
             | (f#fs)  P h  P,hs sh  conf_clinit P sh frs 
             (let (stk,loc,C,M,pc,ics) = f
              in b Ts T mxs mxl0 is xt τ.
                    (P  C sees M,b:TsT = (mxs,mxl0,is,xt) in C) 
                    Φ C M ! pc = Some τ 
                    conf_f P h sh τ is f  conf_fs P h sh Φ C M (size Ts) T fs))
  | Some x  frs = []" 

notation
  correct_state  ("_,_ |- _ [ok]"  [61,0,0] 61)

subsection ‹ Values and @{text "⊤"}

lemma confT_Err [iff]: "P,h  x :≤ Err" 
  by (simp add: confT_def)

lemma confT_OK [iff]:  "P,h  x :≤ OK T = (P,h  x :≤ T)"
  by (simp add: confT_def)

lemma confT_cases:
  "P,h  x :≤ X = (X = Err  (T. X = OK T  P,h  x :≤ T))"
  by (cases X) auto

lemma confT_hext [intro?, trans]:
  " P,h  x :≤ T; h  h'   P,h'  x :≤ T"
  by (cases T) (blast intro: conf_hext)+

lemma confT_widen [intro?, trans]:
  " P,h  x :≤ T; P  T  T'   P,h  x :≤ T'"
  by (cases T', auto intro: conf_widen)


subsection ‹ Stack and Registers ›

lemmas confTs_Cons1 [iff] = list_all2_Cons1 [of "confT P h"] for P h

lemma confTs_confT_sup:
  " P,h  loc [:≤] LT; n < size LT; LT!n = OK T; P  T  T'  
   P,h  (loc!n) :≤ T'"
(*<*)
  apply (frule list_all2_lengthD)
  apply (drule list_all2_nthD, simp)
  apply simp
  apply (erule conf_widen, assumption+)
  done
(*>*)

lemma confTs_hext [intro?]:
  "P,h  loc [:≤] LT  h  h'  P,h'  loc [:≤] LT"
  by (fast elim: list_all2_mono confT_hext)    

lemma confTs_widen [intro?, trans]:
  "P,h  loc [:≤] LT  P  LT [≤] LT'  P,h  loc [:≤] LT'"
  by (rule list_all2_trans, rule confT_widen)

lemma confTs_map [iff]:
  "vs. (P,h  vs [:≤] map OK Ts) = (P,h  vs [:≤] Ts)"
  by (induct Ts) (auto simp: list_all2_Cons2)

lemma reg_widen_Err [iff]:
  "LT. (P  replicate n Err [≤] LT) = (LT = replicate n Err)"
  by (induct n) (auto simp: list_all2_Cons1)
    
lemma confTs_Err [iff]:
  "P,h  replicate n v [:≤] replicate n Err"
  by (induct n) auto

subsection ‹ valid @{text "init_call_status"}

lemma valid_ics_shupd:
assumes "P,h,sh i (C, M, pc, ics)" and "distinct (C'#ics_classes ics)"
shows "P,h,sh(C'  (sfs, i')) i (C, M, pc, ics)"
using assms by(cases ics; clarsimp simp: fun_upd_apply) fastforce
  
subsection ‹ correct-frame ›

lemma conf_f_Throwing:
assumes "conf_f P h sh (ST, LT) is (stk, loc, C, M, pc, Called Cs)"
  and "is_class P C'" and "h xcp = Some obj" and "sh C' = Some(sfs,Processing)"
shows "conf_f P h sh (ST, LT) is (stk, loc, C, M, pc, Throwing (C' # Cs) xcp)"
using assms by(auto simp: conf_f_def2)

lemma conf_f_shupd:
assumes "conf_f P h sh (ST,LT) ins f"
 and "i = Processing
        (distinct (C#ics_classes (ics_of f))  (curr_method f = clinit  C  curr_class f))"
shows "conf_f P h (sh(C  (sfs, i))) (ST,LT) ins f"
using assms
 by(cases f, cases "ics_of f"; clarsimp simp: conf_f_def2 fun_upd_apply) fastforce+

lemma conf_f_shupd':
assumes "conf_f P h sh (ST,LT) ins f"
 and "sh C = Some(sfs,i)"
shows "conf_f P h (sh(C  (sfs', i))) (ST,LT) ins f"
using assms
 by(cases f, cases "ics_of f"; clarsimp simp: conf_f_def2 fun_upd_apply) fastforce+

subsection ‹ correct-frames ›

lemmas [simp del] = fun_upd_apply

lemma conf_fs_hext:
  "C M n Tr. 
   conf_fs P h sh Φ C M n Tr frs; h  h'   conf_fs P h' sh Φ C M n Tr frs"
(*<*)
apply (induct frs)
 apply simp
apply clarify
apply (simp (no_asm_use))
apply clarify
apply (unfold conf_f_def)
apply (simp (no_asm_use))
apply clarify
apply (fastforce elim!: confs_hext confTs_hext)
done
(*>*)


lemma conf_fs_shupd:
assumes "conf_fs P h sh Φ C0 M n T frs"
 and dist: "distinct (C#clinit_classes frs)"
shows "conf_fs P h (sh(C  (sfs, i))) Φ C0 M n T frs"
using assms proof(induct frs arbitrary: C0 C M n T)
  case (Cons f' frs')
  then obtain stk' loc' C' M' pc' ics' where f': "f' = (stk',loc',C',M',pc',ics')" by(cases f')
  with assms Cons obtain ST LT b Ts T1 mxs mxl0 ins xt where
    ty: "Φ C' M' ! pc' = Some (ST,LT)" and
    meth: "P  C' sees M',b:Ts  T1 = (mxs,mxl0,ins,xt) in C'" and
    conf: "conf_f P h sh (ST, LT) ins f'" and
    confs: "conf_fs P h sh Φ C' M' (size Ts) T1 frs'" by clarsimp

  from f' Cons.prems(2) have
   "distinct (C#ics_classes (ics_of f'))  (curr_method f' = clinit  C  curr_class f')"
     by fastforce
  with conf_f_shupd[where C=C, OF conf] have
    conf': "conf_f P h (sh(C  (sfs, i))) (ST, LT) ins f'" by simp

  from Cons.prems(2) have dist': "distinct (C # clinit_classes frs')"
    by(auto simp: distinct_length_2_or_more)
  from Cons.hyps[OF confs dist'] have
    confs': "conf_fs P h (sh(C  (sfs, i))) Φ C' M' (length Ts) T1 frs'" by simp

  from conf' confs' ty meth f' Cons.prems show ?case by(fastforce dest: sees_method_fun)
qed(simp)

lemma conf_fs_shupd':
assumes "conf_fs P h sh Φ C0 M n T frs"
 and shC: "sh C = Some(sfs,i)"
shows "conf_fs P h (sh(C  (sfs', i))) Φ C0 M n T frs"
using assms proof(induct frs arbitrary: C0 C M n T sfs i sfs')
  case (Cons f' frs')
  then obtain stk' loc' C' M' pc' ics' where f': "f' = (stk',loc',C',M',pc',ics')" by(cases f')
  with assms Cons obtain ST LT b Ts T1 mxs mxl0 ins xt where
    ty: "Φ C' M' ! pc' = Some (ST,LT)" and
    meth: "P  C' sees M',b:Ts  T1 = (mxs,mxl0,ins,xt) in C'" and
    conf: "conf_f P h sh (ST, LT) ins f'" and
    confs: "conf_fs P h sh Φ C' M' (size Ts) T1 frs'" and
    shC': "sh C = Some(sfs,i)" by clarsimp

  have conf': "conf_f P h (sh(C  (sfs', i))) (ST, LT) ins f'" by(rule conf_f_shupd'[OF conf shC'])

  from Cons.hyps[OF confs shC'] have
    confs': "conf_fs P h (sh(C  (sfs', i))) Φ C' M' (length Ts) T1 frs'" by simp

  from conf' confs' ty meth f' Cons.prems show ?case by(fastforce dest: sees_method_fun)
qed(simp)

subsection ‹ correctness wrt @{term clinit} use ›

lemma conf_clinit_Cons:
assumes "conf_clinit P sh (f#frs)"
shows "conf_clinit P sh frs"
proof -
  from assms have dist: "distinct_clinit (f#frs)"
   by(cases "curr_method f = clinit", auto simp: conf_clinit_def)
  then have dist': "distinct_clinit frs" by(simp add: distinct_clinit_def)

  with assms show ?thesis by(cases frs; fastforce simp: conf_clinit_def)
qed

lemma conf_clinit_Cons_Cons:
 "conf_clinit P sh (f'#f#frs)  conf_clinit P sh (f'#frs)"
 by(auto simp: conf_clinit_def distinct_clinit_def)

lemma conf_clinit_diff:
assumes "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
shows "conf_clinit P sh ((stk',loc',C,M,pc',ics)#frs)"
using assms by(cases "M = clinit", simp_all add: conf_clinit_def distinct_clinit_def)

lemma conf_clinit_diff':
assumes "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
shows "conf_clinit P sh ((stk',loc',C,M,pc',No_ics)#frs)"
using assms by(cases "M = clinit", simp_all add: conf_clinit_def distinct_clinit_def)

lemma conf_clinit_Called_Throwing:
 "conf_clinit P sh ((stk', loc', C', clinit, pc', ics') # (stk, loc, C, M, pc, Called Cs) # fs)
   conf_clinit P sh ((stk, loc, C, M, pc, Throwing (C' # Cs) xcp) # fs)"
 by(simp add: conf_clinit_def distinct_clinit_def)

lemma conf_clinit_Throwing:
 "conf_clinit P sh ((stk, loc, C, M, pc, Throwing (C'#Cs) xcp) # fs)
   conf_clinit P sh ((stk, loc, C, M, pc, Throwing Cs xcp) # fs)"
 by(simp add: conf_clinit_def distinct_clinit_def)

lemma conf_clinit_Called:
 " conf_clinit P sh ((stk, loc, C, M, pc, Called (C'#Cs)) # frs);
    P  C' sees clinit,Static: []  Void=(mxs',mxl',ins',xt') in C' 
   conf_clinit P sh (create_init_frame P C' # (stk, loc, C, M, pc, Called Cs) # frs)"
 by(simp add: conf_clinit_def distinct_clinit_def)

lemma conf_clinit_Cons_nclinit:
assumes "conf_clinit P sh frs" and nclinit: "M  clinit"
shows "conf_clinit P sh ((stk, loc, C, M, pc, No_ics) # frs)"
proof -
  from nclinit
  have "clinit_classes ((stk, loc, C, M, pc, No_ics) # frs) = clinit_classes frs" by simp
  with assms show ?thesis by(simp add: conf_clinit_def distinct_clinit_def)
qed

lemma conf_clinit_Invoke:
assumes "conf_clinit P sh ((stk, loc, C, M, pc, ics) # frs)" and "M'  clinit"
shows "conf_clinit P sh ((stk', loc', C', M', pc', No_ics) # (stk, loc, C, M, pc, No_ics) # frs)"
 using assms conf_clinit_Cons_nclinit conf_clinit_diff' by auto

lemma conf_clinit_nProc_dist:
assumes "conf_clinit P sh frs"
  and "sfs. sh C  Some(sfs,Processing)"
shows "distinct (C # clinit_classes frs)"
using assms by(auto simp: conf_clinit_def distinct_clinit_def)


lemma conf_clinit_shupd:
assumes "conf_clinit P sh frs"
 and dist: "distinct (C#clinit_classes frs)"
shows "conf_clinit P (sh(C  (sfs, i))) frs"
using assms by(simp add: conf_clinit_def fun_upd_apply)

lemma conf_clinit_shupd':
assumes "conf_clinit P sh frs"
 and "sh C = Some(sfs,i)"
shows "conf_clinit P (sh(C  (sfs', i))) frs"
using assms by(fastforce simp: conf_clinit_def fun_upd_apply)

lemma conf_clinit_shupd_Called:
assumes "conf_clinit P sh ((stk,loc,C,M,pc,Calling C' Cs)#frs)"
 and dist: "distinct (C'#clinit_classes ((stk,loc,C,M,pc,Calling C' Cs)#frs))"
 and cls: "is_class P C'"
shows "conf_clinit P (sh(C'  (sfs, Processing))) ((stk,loc,C,M,pc,Called (C'#Cs))#frs)"
using assms by(clarsimp simp: conf_clinit_def fun_upd_apply distinct_clinit_def)

lemma conf_clinit_shupd_Calling:
assumes "conf_clinit P sh ((stk,loc,C,M,pc,Calling C' Cs)#frs)"
 and dist: "distinct (C'#clinit_classes ((stk,loc,C,M,pc,Calling C' Cs)#frs))"
 and cls: "is_class P C'"
shows "conf_clinit P (sh(C'  (sfs, Processing)))
         ((stk,loc,C,M,pc,Calling (fst(the(class P C'))) (C'#Cs))#frs)"
using assms by(clarsimp simp: conf_clinit_def fun_upd_apply distinct_clinit_def)

subsection ‹ correct state ›

lemma correct_state_Cons:
assumes cr: "P,Φ |- (xp,h,f#frs,sh) [ok]"
shows "P,Φ |- (xp,h,frs,sh) [ok]"
proof -
  from cr have dist: "conf_clinit P sh (f#frs)"
   by(simp add: correct_state_def)
  then have "conf_clinit P sh frs" by(rule conf_clinit_Cons)

  with cr show ?thesis by(cases frs; fastforce simp: correct_state_def)
qed

lemma correct_state_shupd:
assumes cs: "P,Φ |- (xp,h,frs,sh) [ok]" and shC: "sh C = Some(sfs,i)"
 and dist: "distinct (C#clinit_classes frs)"
shows "P,Φ |- (xp,h,frs,sh(C  (sfs, i'))) [ok]"
using assms
proof(cases xp)
  case None with assms show ?thesis
  proof(cases frs)
    case (Cons f' frs')
    let ?sh = "sh(C  (sfs, i'))"

    obtain stk' loc' C' M' pc' ics' where f': "f' = (stk',loc',C',M',pc',ics')" by(cases f')
    with cs Cons None obtain b Ts T mxs mxl0 ins xt ST LT where
         meth: "P  C' sees M',b:TsT = (mxs,mxl0,ins,xt) in C'"
     and ty: "Φ C' M' ! pc' = Some (ST,LT)" and conf: "conf_f P h sh (ST,LT) ins f'"
     and confs: "conf_fs P h sh Φ C' M' (size Ts) T frs'"
     and confc: "conf_clinit P sh frs"
     and h_ok: "P h" and sh_ok: "P,h s sh "
    by(auto simp: correct_state_def)

    from Cons dist have dist': "distinct (C#clinit_classes frs')"
     by(auto simp: distinct_length_2_or_more)

    from shconf_upd_obj[OF sh_ok shconfD[OF sh_ok shC]] have sh_ok': "P,h s ?sh "
      by simp

    from conf f' valid_ics_shupd Cons dist have conf': "conf_f P h ?sh (ST,LT) ins f'"
     by(auto simp: conf_f_def2 fun_upd_apply)
    have confs': "conf_fs P h ?sh Φ C' M' (size Ts) T frs'" by(rule conf_fs_shupd[OF confs dist'])

    have confc': "conf_clinit P ?sh frs" by(rule conf_clinit_shupd[OF confc dist])

    with h_ok sh_ok' meth ty conf' confs' f' Cons None show ?thesis
     by(fastforce simp: correct_state_def)
  qed(simp add: correct_state_def)
qed(simp add: correct_state_def)

lemma correct_state_Throwing_ex:
assumes correct: "P,Φ  (xp,h,(stk,loc,C,M,pc,ics)#frs,sh)"
shows "Cs a. ics = Throwing Cs a  obj. h a = Some obj"
using correct by(clarsimp simp: correct_state_def conf_f_def)

end

Theory ClassAdd

(*  Title: JinjaDCI/BV/ClassAdd.thy
    Author:     Susannah Mansky
    2019-20, UIUC
*)

section ‹ Property preservation under @{text "class_add"}

theory ClassAdd
imports BVConform
begin


lemma err_mono: "A  B  err A  err B"
 by(unfold err_def) auto

lemma opt_mono: "A  B  opt A  opt B"
 by(unfold opt_def) auto

lemma list_mono:
assumes "A  B" shows "list n A  list n B"
proof(rule)
  fix xs assume "xs  list n A"
  then obtain size: "size xs = n" and inA: "set xs  A" by simp
  with assms have "set xs  B" by simp
  with size show "xs  list n B" by(clarsimp intro!: listI)
qed

(****************************************************************)

― ‹ adding a class in the simplest way ›
abbreviation class_add :: "jvm_prog  jvm_method cdecl  jvm_prog" where
"class_add P cd  cd#P"


subsection "Fields"

lemma class_add_has_fields:
assumes fs: "P  D has_fields FDTs" and nc: "¬is_class P C"
shows "class_add P (C, cdec)  D has_fields FDTs"
using assms
proof(induct rule: Fields.induct)
  case (has_fields_Object D fs ms FDTs)
  from has_fields_is_class_Object[OF fs] nc have "C  Object" by fast
  with has_fields_Object show ?case
   by(auto simp: class_def fun_upd_apply intro!: TypeRel.has_fields_Object)
next
  case rec: (has_fields_rec C1 D fs ms FDTs FDTs')
  with has_fields_is_class have [simp]: "D  C" by auto
  with rec have "C1  C" by(clarsimp simp: is_class_def)
  with rec show ?case
   by(auto simp: class_def fun_upd_apply intro: TypeRel.has_fields_rec)
qed

lemma class_add_has_fields_rev:
 " class_add P (C, cdec)  D has_fields FDTs; ¬P  D * C 
  P  D has_fields FDTs"
proof(induct rule: Fields.induct)
  case (has_fields_Object D fs ms FDTs)
  then show ?case by(auto simp: class_def fun_upd_apply intro!: TypeRel.has_fields_Object)
next
  case rec: (has_fields_rec C1 D fs ms FDTs FDTs')
  then have sub1: "P  C1 1 D"
   by(auto simp: class_def fun_upd_apply intro!: subcls1I split: if_split_asm)
  with rec.prems have cls: "¬ P  D * C" by (meson converse_rtrancl_into_rtrancl)
  with cls rec show ?case
   by(auto simp: class_def fun_upd_apply
           intro: TypeRel.has_fields_rec split: if_split_asm)
qed

lemma class_add_has_field:
assumes "P  C0 has F,b:T in D" and "¬ is_class P C"
shows "class_add P (C, cdec)  C0 has F,b:T in D"
using assms by(auto simp: has_field_def dest!: class_add_has_fields[of P C0])

lemma class_add_has_field_rev:
assumes has: "class_add P (C, cdec)  C0 has F,b:T in D"
 and ncp: "D'. P  C0 * D'  D'  C"
shows "P  C0 has F,b:T in D"
using assms by(auto simp: has_field_def dest!: class_add_has_fields_rev)

lemma class_add_sees_field:
assumes "P  C0 sees F,b:T in D" and "¬ is_class P C"
shows "class_add P (C, cdec)  C0 sees F,b:T in D"
using assms by(auto simp: sees_field_def dest!: class_add_has_fields[of P C0])

lemma class_add_sees_field_rev:
assumes has: "class_add P (C, cdec)  C0 sees F,b:T in D"
 and ncp: "D'. P  C0 * D'  D'  C"
shows "P  C0 sees F,b:T in D"
using assms by(auto simp: sees_field_def dest!: class_add_has_fields_rev)

lemma class_add_field:
assumes fd: "P  C0 sees F,b:T in D" and "¬ is_class P C"
shows "field P C0 F = field (class_add P (C, cdec)) C0 F"
using class_add_sees_field[OF assms, of cdec] fd by simp

subsection "Methods"

lemma class_add_sees_methods:
assumes ms: "P  D sees_methods Mm" and nc: "¬is_class P C"
shows "class_add P (C, cdec)  D sees_methods Mm"
using assms
proof(induct rule: Methods.induct)
  case (sees_methods_Object D fs ms Mm)
  from sees_methods_is_class_Object[OF ms] nc have "C  Object" by fast
  with sees_methods_Object show ?case
   by(auto simp: class_def fun_upd_apply intro!: TypeRel.sees_methods_Object)
next
  case rec: (sees_methods_rec C1 D fs ms Mm Mm')
  with sees_methods_is_class have [simp]: "D  C" by auto
  with rec have "C1  C" by(clarsimp simp: is_class_def)
  with rec show ?case
   by(auto simp: class_def fun_upd_apply intro: TypeRel.sees_methods_rec)
qed

lemma class_add_sees_methods_rev:
 " class_add P (C, cdec)  D sees_methods Mm;
    D'. P  D * D'  D'  C 
  P  D sees_methods Mm"
proof(induct rule: Methods.induct)
  case (sees_methods_Object D fs ms Mm)
  then show ?case
   by(auto simp: class_def fun_upd_apply intro!: TypeRel.sees_methods_Object)
next
  case rec: (sees_methods_rec C1 D fs ms Mm Mm')
  then have sub1: "P  C1 1 D"
   by(auto simp: class_def fun_upd_apply intro!: subcls1I)
  have cls: "D'. P  D * D'  D'  C"
  proof -
    fix D' assume "P  D * D'"
    with sub1 have "P  C1 * D'" by simp
    with rec.prems show "D'  C" by simp
  qed
  with cls rec show ?case
   by(auto simp: class_def fun_upd_apply intro: TypeRel.sees_methods_rec)
qed

lemma class_add_sees_methods_Obj:
assumes "P  Object sees_methods Mm" and nObj: "C  Object"
shows "class_add P (C, cdec)  Object sees_methods Mm"
proof -
  from assms obtain C' fs ms where cls: "class P Object = Some(C',fs,ms)"
     by(auto elim!: Methods.cases)
  with nObj have cls': "class (class_add P (C, cdec)) Object = Some(C',fs,ms)"
     by(simp add: class_def fun_upd_apply)
  from assms cls have "Mm = map_option (λm. (m, Object))  map_of ms" by(auto elim!: Methods.cases)
  with assms cls' show ?thesis
   by(auto simp: is_class_def fun_upd_apply intro!: sees_methods_Object)
qed

lemma class_add_sees_methods_rev_Obj:
assumes "class_add P (C, cdec)  Object sees_methods Mm" and nObj: "C  Object"
shows "P  Object sees_methods Mm"
proof -
  from assms obtain C' fs ms where cls: "class (class_add P (C, cdec)) Object = Some(C',fs,ms)"
     by(auto elim!: Methods.cases)
  with nObj have cls': "class P Object = Some(C',fs,ms)"
     by(simp add: class_def fun_upd_apply)
  from assms cls have "Mm = map_option (λm. (m, Object))  map_of ms" by(auto elim!: Methods.cases)
  with assms cls' show ?thesis
   by(auto simp: is_class_def fun_upd_apply intro!: sees_methods_Object)
qed

lemma class_add_sees_method:
assumes "P  C0 sees M0, b : TsT = m in D" and "¬ is_class P C"
shows "class_add P (C, cdec)  C0 sees M0, b : TsT = m in D"
using assms by(auto simp: Method_def dest!: class_add_sees_methods[of P C0])

lemma class_add_method:
assumes md: "P  C0 sees M0, b : TsT = m in D" and "¬ is_class P C"
shows "method P C0 M0 = method (class_add P (C, cdec)) C0 M0"
using class_add_sees_method[OF assms, of cdec] md by simp

lemma class_add_sees_method_rev:
 " class_add P (C, cdec)  C0 sees M0, b : TsT = m in D;
    ¬ P  C0 * C 
   P  C0 sees M0, b : TsT = m in D"
 by(auto simp: Method_def dest!: class_add_sees_methods_rev)

lemma class_add_sees_method_Obj:
 " P  Object sees M0, b : TsT = m in D; C  Object 
   class_add P (C, cdec)  Object sees M0, b : TsT = m in D"
 by(auto simp: Method_def dest!: class_add_sees_methods_Obj[where P=P])

lemma class_add_sees_method_rev_Obj:
 " class_add P (C, cdec)  Object sees M0, b : TsT = m in D; C  Object 
   P  Object sees M0, b : TsT = m in D"
 by(auto simp: Method_def dest!: class_add_sees_methods_rev_Obj[where P=P])

subsection "Types and states"

lemma class_add_is_type:
 "is_type P T  is_type (class_add P (C, cdec)) T"
 by(cases cdec, simp add: is_type_def is_class_def class_def fun_upd_apply split: ty.splits)

lemma class_add_types:
 "types P  types (class_add P (C, cdec))"
using class_add_is_type by(cases cdec, clarsimp)

lemma class_add_states:
 "states P mxs mxl  states (class_add P (C, cdec)) mxs mxl"
proof -
  let ?A = "types P" and ?B = "types (class_add P (C, cdec))"
  have ab: "?A  ?B" by(rule class_add_types)
  moreover have "n. list n ?A  list n ?B" using ab by(rule list_mono)
  moreover have "list mxl (err ?A)  list mxl (err ?B)" using err_mono[OF ab] by(rule list_mono)
  ultimately show ?thesis by(auto simp: JVM_states_unfold intro!: err_mono opt_mono)
qed

lemma class_add_check_types:
 "check_types P mxs mxl τs  check_types (class_add P (C, cdec)) mxs mxl τs"
using class_add_states by(fastforce simp: check_types_def)

subsection "Subclasses and subtypes"

lemma class_add_subcls:
 " P  D * D'; ¬ is_class P C 
  class_add P (C, cdec)  D * D'"
proof(induct rule: rtrancl.induct)
  case (rtrancl_into_rtrancl a b c)
  then have "b  C" by(clarsimp simp: is_class_def dest!: subcls1D)
  with rtrancl_into_rtrancl show ?case
   by(fastforce dest!: subcls1D simp: class_def fun_upd_apply
                intro!: rtrancl_trans[of a b] subcls1I)
qed(simp)

lemma class_add_subcls_rev:
 " class_add P (C, cdec)  D * D'; ¬P  D * C 
  P  D * D'"
proof(induct rule: rtrancl.induct)
  case (rtrancl_into_rtrancl a b c)
  then have "b  C" by(clarsimp simp: is_class_def dest!: subcls1D)
  with rtrancl_into_rtrancl show ?case
   by(fastforce dest!: subcls1D simp: class_def fun_upd_apply
                intro!: rtrancl_trans[of a b] subcls1I)
qed(simp)

lemma class_add_subtype:
 " subtype P x y; ¬ is_class P C 
  subtype (class_add P (C, cdec)) x y"
proof(induct rule: widen.induct)
  case (widen_subcls C D)
  then show ?case using class_add_subcls by simp
qed(simp+)

lemma class_add_widens:
 " P  Ts [≤] Ts'; ¬ is_class P C 
  (class_add P (C, cdec))  Ts [≤] Ts'"
using class_add_subtype by (metis (no_types) list_all2_mono)

lemma class_add_sup_ty_opt:
 " P  l1  l2; ¬ is_class P C 
   class_add P (C, cdec)  l1  l2"
using class_add_subtype by(auto simp: sup_ty_opt_def Err.le_def lesub_def split: err.splits)

lemma class_add_sup_loc:
" P  LT [≤] LT'; ¬ is_class P C 
  class_add P (C, cdec)  LT [≤] LT'"
using class_add_sup_ty_opt[where P=P and C=C] by (simp add: list.rel_mono_strong)

lemma class_add_sup_state:
 " P  τ i τ'; ¬ is_class P C 
   class_add P (C, cdec)  τ i τ'"
using class_add_subtype class_add_sup_ty_opt
 by(auto simp: sup_state_def Listn.le_def Product.le_def lesub_def class_add_widens
               class_add_sup_ty_opt list_all2_mono)

lemma class_add_sup_state_opt:
 " P  τ ≤' τ'; ¬ is_class P C 
  class_add P (C, cdec)  τ ≤' τ'"
 by(auto simp: sup_state_opt_def Opt.le_def lesub_def class_add_widens
               class_add_sup_ty_opt list_all2_mono)

subsection "Effect"

lemma class_add_is_relevant_class:
 " is_relevant_class i P C0; ¬ is_class P C 
   is_relevant_class i (class_add P (C, cdec)) C0"
  by(cases i, auto simp: class_add_subcls)

lemma class_add_is_relevant_class_rev:
assumes irc: "is_relevant_class i (class_add P (C, cdec)) C0"
  and ncp: "cd D'. cd  set P  ¬P  fst cd * C"
  and wfxp: "wf_syscls P"
shows "is_relevant_class i P C0"
using assms
proof(cases i)
  case (Getfield F D) with assms
  show ?thesis by(fastforce simp: wf_syscls_def sys_xcpts_def dest!: class_add_subcls_rev)
next
  case (Putfield F D) with assms
  show ?thesis by(fastforce simp: wf_syscls_def sys_xcpts_def dest!: class_add_subcls_rev)
next
  case (Checkcast D) with assms
  show ?thesis by(fastforce simp: wf_syscls_def sys_xcpts_def dest!: class_add_subcls_rev)
qed(simp_all)

lemma class_add_is_relevant_entry:
 " is_relevant_entry P i pc e; ¬ is_class P C 
   is_relevant_entry (class_add P (C, cdec)) i pc e"
 by(clarsimp simp: is_relevant_entry_def class_add_is_relevant_class)

lemma class_add_is_relevant_entry_rev:
 " is_relevant_entry (class_add P (C, cdec)) i pc e; 
    cd D'. cd  set P  ¬P  fst cd * C;
    wf_syscls P 
   is_relevant_entry P i pc e"
 by(auto simp: is_relevant_entry_def dest!: class_add_is_relevant_class_rev)

lemma class_add_relevant_entries:
 "¬ is_class P C
   set (relevant_entries P i pc xt)  set (relevant_entries (class_add P (C, cdec)) i pc xt)"
 by(clarsimp simp: relevant_entries_def class_add_is_relevant_entry)

lemma class_add_relevant_entries_eq:
assumes wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "relevant_entries P i pc xt = relevant_entries (class_add P (C, cdec)) i pc xt"
proof -
  have ncp: "cd D'. cd  set P  ¬P  fst cd * C"
   by(rule wf_subcls_nCls'[OF assms])
  moreover from wf have wfsys: "wf_syscls P" by(simp add: wf_prog_def)
  moreover
  note class_add_is_relevant_entry[OF _ nclass, of i pc _ cdec]
       class_add_is_relevant_entry_rev[OF _ ncp wfsys, of cdec i pc]
  ultimately show ?thesis by (metis filter_cong relevant_entries_def)
qed

lemma class_add_norm_eff_pc:
assumes ne: "(pc',τ')  set (norm_eff i P pc τ). pc' < mpc"
shows "(pc',τ')  set (norm_eff i (class_add P (C, cdec)) pc τ). pc' < mpc"
using assms by(cases i, auto simp: norm_eff_def)

lemma class_add_norm_eff_sup_state_opt:
assumes ne: "(pc',τ')  set (norm_eff i P pc τ). P  τ' ≤' τs!pc'"
   and nclass: "¬ is_class P C" and app: "appi (i, P, pc, mxs, T, τ)"
shows "(pc',τ')  set (norm_eff i (class_add P (C, cdec)) pc τ). (class_add P (C, cdec))  τ' ≤' τs!pc'"
proof -
  obtain ST LT where "τ = (ST,LT)" by(cases τ)
  with assms show ?thesis proof(cases i)
  qed(fastforce simp: norm_eff_def
                dest!: class_add_field[where cdec=cdec] class_add_method[where cdec=cdec]
                       class_add_sup_loc[OF _ nclass] class_add_subtype[OF _ nclass]
                       class_add_widens[OF _ nclass] class_add_sup_state_opt[OF _ nclass])+
qed

lemma class_add_xcpt_eff_eq:
assumes wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "xcpt_eff i P pc τ xt = xcpt_eff i (class_add P (C, cdec)) pc τ xt"
using class_add_relevant_entries_eq[OF assms, of i pc xt cdec] by(cases τ, simp add: xcpt_eff_def)

lemma class_add_eff_pc:
assumes eff: "(pc',τ')  set (eff i P pc xt (Some τ)). pc' < mpc"
  and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "(pc',τ')  set (eff i (class_add P (C, cdec)) pc xt (Some τ)). pc' < mpc"
using eff class_add_norm_eff_pc class_add_xcpt_eff_eq[OF wf nclass]
  by(auto simp: norm_eff_def eff_def)

lemma class_add_eff_sup_state_opt:
assumes eff: "(pc',τ')  set (eff i P pc xt (Some τ)). P  τ' ≤' τs!pc'"
  and wf: "wf_prog wf_md P"and nclass: "¬ is_class P C"
  and app: "appi (i, P, pc, mxs, T, τ)"
shows "(pc',τ')  set (eff i (class_add P (C, cdec)) pc xt (Some τ)).
         (class_add P (C, cdec))  τ' ≤' τs!pc'"
proof -
  from eff have ne: "(pc', τ')set (norm_eff i P pc τ). P  τ' ≤' τs ! pc'"
   by(simp add: norm_eff_def eff_def)
  from eff have "(pc', τ')set (xcpt_eff i P pc τ xt). P  τ' ≤' τs ! pc'"
   by(simp add: xcpt_eff_def eff_def)
  with class_add_norm_eff_sup_state_opt[OF ne nclass app]
       class_add_xcpt_eff_eq[OF wf nclass]class_add_sup_state_opt[OF _ nclass]
    show ?thesis by(cases cdec, auto simp: eff_def norm_eff_def xcpt_app_def)
qed


lemma class_add_appi:
assumes "appi (i, P, pc, mxs, Tr, ST, LT)" and "¬ is_class P C"
shows "appi (i, class_add P (C, cdec), pc, mxs, Tr, ST, LT)"
using assms
proof(cases i)
  case New then show ?thesis using assms by(fastforce simp: is_class_def class_def fun_upd_apply)
next
  case Getfield then show ?thesis using assms
   by(auto simp: class_add_subtype dest!: class_add_sees_field[where P=P])
next
  case Getstatic then show ?thesis using assms by(auto dest!: class_add_sees_field[where P=P])
next
  case Putfield then show ?thesis using assms
   by(auto dest!: class_add_subtype[where P=P] class_add_sees_field[where P=P])
next
  case Putstatic then show ?thesis using assms
   by(auto dest!: class_add_subtype[where P=P] class_add_sees_field[where P=P])
next
  case Checkcast then show ?thesis using assms
   by(clarsimp simp: is_class_def class_def fun_upd_apply)
next
  case Invoke then show ?thesis using assms
    by(fastforce dest!: class_add_widens[where P=P] class_add_sees_method[where P=P])
next
  case Invokestatic then show ?thesis using assms
    by(fastforce dest!: class_add_widens[where P=P] class_add_sees_method[where P=P])
next
  case Return then show ?thesis using assms by(clarsimp simp: class_add_subtype)
qed(simp+)

lemma class_add_xcpt_app:
assumes xa: "xcpt_app i P pc mxs xt τ"
 and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "xcpt_app i (class_add P (C, cdec)) pc mxs xt τ"
using xa class_add_relevant_entries_eq[OF wf nclass] nclass
 by(auto simp: xcpt_app_def is_class_def class_def fun_upd_apply) auto

lemma class_add_app:
assumes app: "app i P mxs T pc mpc xt t"
 and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "app i (class_add P (C, cdec)) mxs T pc mpc xt t"
proof(cases t)
  case (Some τ)
  let ?P = "class_add P (C, cdec)"
  from assms Some have eff: "(pc', τ')set (eff i P pc xt τ). pc' < mpc" by(simp add: app_def)
  from assms Some have appi: "appi (i,P,pc,mxs,T,τ)" by(simp add: app_def)
  with class_add_appi[OF _ nclass] Some have "appi (i,?P,pc,mxs,T,τ)" by(cases τ,simp)
  moreover
  from app class_add_xcpt_app[OF _ wf nclass] Some
  have "xcpt_app i ?P pc mxs xt τ" by(simp add: app_def del: xcpt_app_def)
  moreover
  from app class_add_eff_pc[OF eff wf nclass] Some
  have "(pc',τ')  set (eff i ?P pc xt t). pc' < mpc" by auto
  moreover note app Some
  ultimately show ?thesis by(simp add: app_def)
qed(simp)

subsection "Well-formedness and well-typedness"

lemma class_add_wf_mdecl:
  " wf_mdecl wf_md P C0 md;
     C0 md. wf_md P C0 md  wf_md (class_add P (C, cdec)) C0 md 
   wf_mdecl wf_md (class_add P (C, cdec)) C0 md"
 by(clarsimp simp: wf_mdecl_def class_add_is_type)

lemma class_add_wf_mdecl':
assumes wfd: "wf_mdecl wf_md P C0 md"
  and ms: "(C0,S,fs,ms)  set P" and md: "md  set ms"
  and wf_md': "C0 S fs ms m.(C0,S,fs,ms)  set P; m  set ms  wf_md' (class_add P (C, cdec)) C0 m"
shows "wf_mdecl wf_md' (class_add P (C, cdec)) C0 md"
using assms by(clarsimp simp: wf_mdecl_def class_add_is_type)

lemma class_add_wf_cdecl:
assumes wfcd: "wf_cdecl wf_md P cd" and cdP: "cd  set P"
 and ncp: "¬ P  fst cd * C" and dist: "distinct_fst P"
 and wfmd: "C0 md. wf_md P C0 md  wf_md (class_add P (C, cdec)) C0 md"
 and nclass: "¬ is_class P C"
shows "wf_cdecl wf_md (class_add P (C, cdec)) cd"
proof -
  let ?P = "class_add P (C, cdec)"
  obtain C1 D fs ms where [simp]: "cd = (C1,(D,fs,ms))" by(cases cd)
  from wfcd
  have "fset fs. wf_fdecl ?P f" by(auto simp: wf_cdecl_def wf_fdecl_def class_add_is_type)
  moreover
  from wfcd wfmd class_add_wf_mdecl
  have "mset ms. wf_mdecl wf_md ?P C1 m" by(auto simp: wf_cdecl_def)
  moreover
  have "C1  Object  is_class ?P D  ¬ ?P  D * C1
     ((M,b,Ts,T,m)set ms.
        D' b' Ts' T' m'. ?P  D sees M,b':Ts'  T' = m' in D' 
                       b = b'  ?P  Ts' [≤] Ts  ?P  T  T')"
  proof -
    assume nObj[simp]: "C1  Object"
    with cdP dist have sub1: "P  C1 1 D" by(auto simp: class_def intro!: subcls1I map_of_SomeI)
    with ncp have ncp': "¬ P  D * C" by(auto simp: converse_rtrancl_into_rtrancl)
    with wfcd
    have clsD: "is_class ?P D"
     by(auto simp: wf_cdecl_def is_class_def class_def fun_upd_apply)
    moreover
    from wfcd sub1
    have "¬ ?P  D * C1" by(auto simp: wf_cdecl_def dest!: class_add_subcls_rev[OF _ ncp'])
    moreover
    have "M b Ts T m D' b' Ts' T' m'. (M,b,Ts,T,m)  set ms
             ?P  D sees M,b':Ts'  T' = m' in D'
             b = b'  ?P  Ts' [≤] Ts  ?P  T  T'"
    proof -
      fix M b Ts T m D' b' Ts' T' m'
      assume ms: "(M,b,Ts,T,m)  set ms" and meth': "?P  D sees M,b':Ts'  T' = m' in D'"
      with sub1
      have "P  D sees M,b':Ts'  T' = m' in D'"
       by(fastforce dest!: class_add_sees_method_rev[OF _ ncp'])
      moreover
      with wfcd ms meth'
      have "b = b'  P  Ts' [≤] Ts  P  T  T'"
       by(cases m', fastforce simp: wf_cdecl_def elim!: ballE[where x="(M,b,Ts,T,m)"])
      ultimately show "b = b'  ?P  Ts' [≤] Ts  ?P  T  T'"
       by(auto dest!: class_add_subtype[OF _ nclass] class_add_widens[OF _ nclass])
    qed
    ultimately show ?thesis by clarsimp
  qed
  moreover note wfcd
  ultimately show ?thesis by(simp add: wf_cdecl_def)
qed

lemma class_add_wf_cdecl':
assumes wfcd: "wf_cdecl wf_md P cd" and cdP: "cd  set P"
 and ncp: "¬P  fst cd * C" and dist: "distinct_fst P"
 and wfmd: "C0 S fs ms m.(C0,S,fs,ms)  set P; m  set ms  wf_md' (class_add P (C, cdec)) C0 m"
 and nclass: "¬ is_class P C"
shows "wf_cdecl wf_md' (class_add P (C, cdec)) cd"
proof -
  let ?P = "class_add P (C, cdec)"
  obtain C1 D fs ms where [simp]: "cd = (C1,(D,fs,ms))" by(cases cd)
  from wfcd
  have "fset fs. wf_fdecl ?P f" by(auto simp: wf_cdecl_def wf_fdecl_def class_add_is_type)
  moreover
  from cdP wfcd wfmd
  have "mset ms. wf_mdecl wf_md' ?P C1 m"
    by(auto simp: wf_cdecl_def wf_mdecl_def class_add_is_type)
  moreover
  have "C1  Object  is_class ?P D  ¬ ?P  D * C1
     ((M,b,Ts,T,m)set ms.
        D' b' Ts' T' m'. ?P  D sees M,b':Ts'  T' = m' in D' 
                       b = b'  ?P  Ts' [≤] Ts  ?P  T  T')"
  proof -
    assume nObj[simp]: "C1  Object"
    with cdP dist have sub1: "P  C1 1 D" by(auto simp: class_def intro!: subcls1I map_of_SomeI)
    with ncp have ncp': "¬ P  D * C" by(auto simp: converse_rtrancl_into_rtrancl)
    with wfcd
    have clsD: "is_class ?P D"
     by(auto simp: wf_cdecl_def is_class_def class_def fun_upd_apply)
    moreover
    from wfcd sub1
    have "¬ ?P  D * C1" by(auto simp: wf_cdecl_def dest!: class_add_subcls_rev[OF _ ncp'])
    moreover
    have "M b Ts T m D' b' Ts' T' m'. (M,b,Ts,T,m)  set ms
             ?P  D sees M,b':Ts'  T' = m' in D'
             b = b'  ?P  Ts' [≤] Ts  ?P  T  T'"
    proof -
      fix M b Ts T m D' b' Ts' T' m'
      assume ms: "(M,b,Ts,T,m)  set ms" and meth': "?P  D sees M,b':Ts'  T' = m' in D'"
      with sub1
      have "P  D sees M,b':Ts'  T' = m' in D'"
       by(fastforce dest!: class_add_sees_method_rev[OF _ ncp'])
      moreover
      with wfcd ms meth'
      have "b = b'  P  Ts' [≤] Ts  P  T  T'"
       by(cases m', fastforce simp: wf_cdecl_def elim!: ballE[where x="(M,b,Ts,T,m)"])
      ultimately show "b = b'  ?P  Ts' [≤] Ts  ?P  T  T'"
       by(auto dest!: class_add_subtype[OF _ nclass] class_add_widens[OF _ nclass])
    qed
    ultimately show ?thesis by clarsimp
  qed
  moreover note wfcd
  ultimately show ?thesis by(simp add: wf_cdecl_def)
qed

lemma class_add_wt_start:
 " wt_start P C0 b Ts mxl τs; ¬ is_class P C 
  wt_start (class_add P (C, cdec)) C0 b Ts mxl τs"
using class_add_sup_state_opt by(clarsimp simp: wt_start_def split: staticb.splits)

lemma class_add_wt_instr:
assumes wti: "P,T,mxs,mpc,xt  i,pc :: τs"
 and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "class_add P (C, cdec),T,mxs,mpc,xt  i,pc :: τs"
proof -
  let ?P = "class_add P (C, cdec)"
  from wti have eff: "(pc', τ')set (eff i P pc xt (τs ! pc)). P  τ' ≤' τs ! pc'"
   by(simp add: wt_instr_def)
  from wti have appi: "τs!pc  None  appi (i,P,pc,mxs,T,the (τs!pc))"
   by(simp add: wt_instr_def app_def)
  from wti class_add_app[OF _ wf nclass]
  have "app i ?P mxs T pc mpc xt (τs!pc)" by(simp add: wt_instr_def)
  moreover
  have "(pc',τ')  set (eff i ?P pc xt (τs!pc)). ?P  τ' ≤' τs!pc'"
  proof(cases "τs!pc")
    case Some with eff class_add_eff_sup_state_opt[OF _ wf nclass appi] show ?thesis by auto
  qed(simp add: eff_def)
  moreover note wti
  ultimately show ?thesis by(clarsimp simp: wt_instr_def)
qed

lemma class_add_wt_method:
assumes wtm: "wt_method P C0 b Ts Tr mxs mxl0 is xt (Φ C0 M0)"
 and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "wt_method (class_add P (C, cdec)) C0 b Ts Tr mxs mxl0 is xt (Φ C0 M0)"
proof -
  let ?P = "class_add P (C, cdec)"
  let ?τs = "Φ C0 M0"
  from wtm class_add_check_types
  have "check_types ?P mxs ((case b of Static  0 | NonStatic  1)+size Ts+mxl0) (map OK ?τs)"
   by(simp add: wt_method_def)
  moreover
  from wtm class_add_wt_start nclass
  have "wt_start ?P C0 b Ts mxl0 ?τs" by(simp add: wt_method_def)
  moreover
  from wtm class_add_wt_instr[OF _ wf nclass]
  have "pc < size is. ?P,Tr,mxs,size is,xt  is!pc,pc :: ?τs" by(clarsimp simp: wt_method_def)
  moreover note wtm
  ultimately
  show ?thesis by(clarsimp simp: wt_method_def)
qed

lemma class_add_wt_method':
 " (λP C (M,b,Ts,Tr,(mxs,mxl0,is,xt)). wt_method P C b Ts Tr mxs mxl0 is xt (Φ C M)) P C0 md;
    wf_prog wf_md P; ¬ is_class P C 
     (λP C (M,b,Ts,Tr,(mxs,mxl0,is,xt)). wt_method P C b Ts Tr mxs mxl0 is xt (Φ C M))
            (class_add P (C, cdec)) C0 md"
 by(clarsimp simp: class_add_wt_method)

subsection @{text "distinct_fst"}

lemma class_add_distinct_fst:
" distinct_fst P; ¬ is_class P C 
   distinct_fst (class_add P (C, cdec))"
 by(clarsimp simp: distinct_fst_def is_class_def class_def)

subsection "Conformance"

lemma class_add_conf:
 " P,h  v :≤ T; ¬ is_class P C 
  class_add P (C, cdec),h  v :≤ T"
 by(clarsimp simp: conf_def class_add_subtype)

lemma class_add_oconf:
fixes obj::obj
assumes oc: "P,h  obj " and ns: "¬ is_class P C"
  and ncp: "D'. P  fst(obj) * D'  D'  C"
shows "(class_add P (C, cdec)),h  obj "
proof -
  obtain C0 fs where [simp]: "obj=(C0,fs)" by(cases obj)
  from oc have
    oc': "F D T. P  C0 has F,NonStatic:T in D  (v. fs (F, D) = v  P,h  v :≤ T)"
    by(simp add: oconf_def)
  have "F D T. class_add P (C, cdec)  C0 has F,NonStatic:T in D
                        v. fs(F,D) = Some v  class_add P (C, cdec),h  v :≤ T"
  proof -
    fix F D T assume "class_add P (C, cdec)  C0 has F,NonStatic:T in D"
    with class_add_has_field_rev[OF _ ncp] have meth: "P  C0 has F,NonStatic:T in D" by simp
    then show "v. fs(F,D) = Some v  class_add P (C, cdec),h  v :≤ T"
    using oc'[OF meth] class_add_conf[OF _ ns] by(fastforce simp: oconf_def)
  qed
  then show ?thesis by(simp add: oconf_def)
qed

lemma class_add_soconf:
assumes soc: "P,h,C0 s sfs " and ns: "¬ is_class P C"
  and ncp: "D'. P  C0 * D'  D'  C"
shows "(class_add P (C, cdec)),h,C0 s sfs "
proof -
  from soc have
    oc': "F T. P  C0 has F,Static:T in C0  (v. sfs F = v  P,h  v :≤ T)"
    by(simp add: soconf_def)
  have "F T. class_add P (C, cdec)  C0 has F,Static:T in C0
                        v. sfs F = Some v  class_add P (C, cdec),h  v :≤ T"
  proof -
    fix F T assume "class_add P (C, cdec)  C0 has F,Static:T in C0"
    with class_add_has_field_rev[OF _ ncp] have meth: "P  C0 has F,Static:T in C0" by simp
    then show "v. sfs F = Some v  class_add P (C, cdec),h  v :≤ T"
    using oc'[OF meth] class_add_conf[OF _ ns] by(fastforce simp: soconf_def)
  qed
  then show ?thesis by(simp add: soconf_def)
qed

lemma class_add_hconf:
assumes "P  h " and "¬ is_class P C"
 and "a obj D'. h a = Some obj  P  fst(obj) * D'  D'  C"
shows "class_add P (C, cdec)  h "
using assms by(auto simp: hconf_def intro!: class_add_oconf)

lemma class_add_hconf_wf:
assumes wf: "wf_prog wf_md P" and "P  h " and "¬ is_class P C"
 and "a obj. h a = Some obj  fst(obj)  C"
shows "class_add P (C, cdec)  h "
using wf_subcls_nCls[OF wf] assms by(fastforce simp: hconf_def intro!: class_add_oconf)

lemma class_add_shconf:
assumes "P,h s sh " and ns: "¬ is_class P C"
 and "C sobj D'. sh C = Some sobj  P  C * D'  D'  C"
shows "class_add P (C, cdec),h s sh "
using assms by(fastforce simp: shconf_def)

lemma class_add_shconf_wf:
assumes wf: "wf_prog wf_md P" and "P,h s sh " and "¬ is_class P C"
 and "C sobj. sh C = Some sobj  C  C"
shows "class_add P (C, cdec),h s sh "
using wf_subcls_nCls[OF wf] assms by(fastforce simp: shconf_def)


end

Theory StartProg

(*  Title: JinjaDCI/BV/StartProg.thy
    Author:     Susannah Mansky
    2019-20, UIUC
*)
section "Properties and types of the starting program"

theory StartProg
imports ClassAdd
begin

lemmas wt_defs = correct_state_def conf_f_def wt_instr_def eff_def norm_eff_def app_def xcpt_app_def

declare wt_defs [simp] ― ‹ removed from @{text simp} at the end of file ›
declare start_class_def [simp]

subsection "Types"

abbreviation start_φm :: "tym" where
"start_φm  [Some([],[]),Some([Void],[])]"

fun Φ_start :: "tyP  tyP" where
"Φ_start Φ C M = (if C=Start  (M=start_m  M=clinit) then start_φm else Φ C M)"

lemma Φ_start: "C. C  Start  Φ_start Φ C = Φ C"
 "Φ_start Φ Start start_m = start_φm" "Φ_start Φ Start clinit = start_φm"
 by auto

lemma check_types_φm: "check_types (start_prog P C M) 1 0 (map OK start_φm)"
 by (auto simp: check_types_def JVM_states_unfold)

(***************************************************************************************)

subsection "Some simple properties"

lemma preallocated_start_state: "start_state P = σ  preallocated (fst(snd σ))"
using preallocated_start[of P] by(auto simp: start_state_def split_beta)

lemma start_prog_Start_super: "start_prog P C M  Start 1 Object"
 by(auto intro!: subcls1I simp: class_def fun_upd_apply)

lemma start_prog_Start_fields:
 "start_prog P C M  Start has_fields FDTs  map_of FDTs (F, Start) = None"
 by(drule Fields.cases, auto simp: class_def fun_upd_apply Object_fields)

lemma start_prog_Start_soconf:
 "(start_prog P C M),h,Start s Map.empty "
 by(simp add: soconf_def has_field_def start_prog_Start_fields)

lemma start_prog_start_shconf:
 "start_prog P C M,start_heap P s start_sheap "
(*<*) using start_prog_Start_soconf by (simp add: shconf_def fun_upd_apply) (*>*)

(************************************)

subsection "Well-typed and well-formed"

lemma start_wt_method:
assumes "P  C sees M, Static :  []Void = m in D" and "M  clinit" and "¬ is_class P Start"
shows "wt_method (start_prog P C M) Start Static [] Void 1 0 [Invokestatic C M 0, Return] [] start_φm"
 (is "wt_method ?P ?C ?b ?Ts ?Tr ?mxs ?mxl0 ?is ?xt ?τs")
proof -
  let ?cdec = "(Object, [], [start_method C M, start_clinit])"
  obtain mxs mxl ins xt where m: "m = (mxs,mxl,ins,xt)" by(cases m)
  have ca_sees: "class_add P (Start, ?cdec)  C sees M, Static :  []Void = m in D"
    by(rule class_add_sees_method[OF assms(1,3)])
  have "pc. pc < size ?is  ?P,?Tr,?mxs,size ?is,?xt  ?is!pc,pc :: ?τs"
  proof -
    fix pc assume pc: "pc < size ?is"
    then show "?P,?Tr,?mxs,size ?is,?xt  ?is!pc,pc :: ?τs"
    proof(cases "pc = 0")
      case True with assms m ca_sees show ?thesis
       by(fastforce simp: wt_method_def wt_start_def relevant_entries_def
                          is_relevant_entry_def xcpt_eff_def)
    next
      case False with pc show ?thesis
       by(simp add: wt_method_def wt_start_def relevant_entries_def
                    is_relevant_entry_def xcpt_eff_def)
    qed
  qed
  with assms check_types_φm show ?thesis by(simp add: wt_method_def wt_start_def)
qed

lemma start_clinit_wt_method:
assumes "P  C sees M, Static :  []Void = m in D" and "M  clinit" and "¬ is_class P Start"
shows "wt_method (start_prog P C M) Start Static [] Void 1 0 [Push Unit,Return] [] start_φm"
 (is "wt_method ?P ?C ?b ?Ts ?Tr ?mxs ?mxl0 ?is ?xt ?τs")
proof -
  let ?cdec = "(Object, [], [start_method C M, start_clinit])"
  obtain mxs mxl ins xt where m: "m = (mxs,mxl,ins,xt)" by(cases m)
  have ca_sees: "class_add P (Start, ?cdec)  C sees M, Static :  []Void = m in D"
    by(rule class_add_sees_method[OF assms(1,3)])
  have "pc. pc < size ?is  ?P,?Tr,?mxs,size ?is,?xt  ?is!pc,pc :: ?τs"
  proof -
    fix pc assume pc: "pc < size ?is"
    then show "?P,?Tr,?mxs,size ?is,?xt  ?is!pc,pc :: ?τs"
    proof(cases "pc = 0")
      case True with assms m ca_sees show ?thesis
       by(fastforce simp: wt_method_def wt_start_def relevant_entries_def
                          is_relevant_entry_def xcpt_eff_def)
    next
      case False with pc show ?thesis
       by(simp add: wt_method_def wt_start_def relevant_entries_def
                    is_relevant_entry_def xcpt_eff_def)
    qed
  qed
  with assms check_types_φm show ?thesis by(simp add: wt_method_def wt_start_def)
qed

lemma start_class_wf:
assumes "P  C sees M, Static :  []Void = m in D"
 and "M  clinit" and "¬ is_class P Start"
 and "Φ Start start_m = start_φm" and "Φ Start clinit = start_φm"
 and "is_class P Object"
 and "b' Ts' T' m' D'. P  Object sees start_m, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void"
 and "b' Ts' T' m' D'. P  Object sees clinit, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void"
shows "wf_cdecl (λP C (M,b,Ts,Tr,(mxs,mxl0,is,xt)). wt_method P C b Ts Tr mxs mxl0 is xt (Φ C M))
       (start_prog P C M) (start_class C M)"
proof -
  from assms start_wt_method start_clinit_wt_method class_add_sees_method_rev_Obj[where P=P and C=Start]
   show ?thesis
    by(auto simp: start_method_def wf_cdecl_def wf_fdecl_def wf_mdecl_def
                  is_class_def class_def fun_upd_apply wf_clinit_def) fast+
qed

lemma start_prog_wf_jvm_prog_phi:
assumes wtp: "wf_jvm_progΦ P"
 and nstart: "¬ is_class P Start"
 and meth: "P  C sees M, Static :  []Void = m in D" and nclinit: "M  clinit"
 and Φ: "C. C  Start  Φ' C = Φ C"
 and Φ': "Φ' Start start_m = start_φm" "Φ' Start clinit = start_φm"
 and Obj_start_m: "b' Ts' T' m' D'. P  Object sees start_m, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void"
shows "wf_jvm_progΦ' (start_prog P C M)"
proof -
  let ?wf_md = "(λP C (M,b,Ts,Tr,(mxs,mxl0,is,xt)). wt_method P C b Ts Tr mxs mxl0 is xt (Φ C M))"
  let ?wf_md' = "(λP C (M,b,Ts,Tr,(mxs,mxl0,is,xt)). wt_method P C b Ts Tr mxs mxl0 is xt (Φ' C M))"
  from wtp have wf: "wf_prog ?wf_md P" by(simp add: wf_jvm_prog_phi_def)
  from wf_subcls_nCls'[OF wf nstart]
  have nsp: "cd D'. cd  set P  ¬P  fst cd * Start" by simp
  have wf_md':
    "C0 S fs ms m. (C0, S, fs, ms)  set P  m  set ms  ?wf_md' (start_prog P C M) C0 m"
  proof -
    fix C0 S fs ms m assume asms: "(C0, S, fs, ms)  set P" "m  set ms"
    with nstart have ns: "C0  Start" by(auto simp: is_class_def class_def dest: weak_map_of_SomeI)
    from wf asms have "?wf_md P C0 m" by(auto simp: wf_prog_def wf_cdecl_def wf_mdecl_def)

    with Φ[OF ns] class_add_wt_method[OF _ wf nstart]
     show "?wf_md' (start_prog P C M) C0 m" by fastforce
  qed
  from wtp have a1: "is_class P Object" by (simp add: wf_jvm_prog_phi_def)
  with wf_sees_clinit[where P=P and C=Object] wtp
   have a2: "b' Ts' T' m' D'. P  Object sees clinit, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void"
    by(fastforce simp: wf_jvm_prog_phi_def is_class_def dest: sees_method_fun)
  from wf have dist: "distinct_fst P" by (simp add: wf_prog_def)
  with class_add_distinct_fst[OF _ nstart] have "distinct_fst (start_prog P C M)" by simp
  moreover from wf have "wf_syscls (start_prog P C M)" by(simp add: wf_prog_def wf_syscls_def)
  moreover
  from class_add_wf_cdecl'[where wf_md'="?wf_md'", OF _ _ nsp dist] wf_md' nstart wf
  have "c. c  set P  wf_cdecl ?wf_md' (start_prog P C M) c" by(fastforce simp: wf_prog_def)
  moreover from start_class_wf[OF meth] nclinit nstart Φ' a1 Obj_start_m a2
  have "wf_cdecl ?wf_md' (start_prog P C M) (start_class C M)" by simp
  ultimately show ?thesis by(simp add: wf_jvm_prog_phi_def wf_prog_def)
qed

lemma start_prog_wf_jvm_prog:
assumes wf: "wf_jvm_prog P"
 and nstart: "¬ is_class P Start"
 and meth: "P  C sees M, Static :  []Void = m in D" and nclinit: "M  clinit"
 and Obj_start_m: "b' Ts' T' m' D'. P  Object sees start_m, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void"
shows "wf_jvm_prog (start_prog P C M)"
proof -
  from wf obtain Φ where wtp: "wf_jvm_progΦ P" by(clarsimp simp: wf_jvm_prog_def)

  let ?Φ' = "λC f. if C = Start  (f = start_m  f = clinit) then start_φm else Φ C f"

  from start_prog_wf_jvm_prog_phi[OF wtp nstart meth nclinit _ _ _ Obj_start_m] have
    "wf_jvm_prog?Φ' (start_prog P C M)" by simp
  then show ?thesis by(auto simp: wf_jvm_prog_def)
qed

(*****************************************************************************)

subsection "Methods and instructions"

lemma start_prog_Start_sees_methods:
 "P  Object sees_methods Mm
  start_prog P C M 
  Start sees_methods Mm ++ (map_option (λm. (m,Start))  map_of [start_method C M, start_clinit])"
 by (auto simp: class_def fun_upd_apply
          dest!: class_add_sees_methods_Obj[where P=P and C=Start] intro: sees_methods_rec)

lemma start_prog_Start_sees_start_method:
 "P  Object sees_methods Mm
   start_prog P C M 
         Start sees start_m, Static : []Void = (1, 0, [Invokestatic C M 0,Return], []) in Start"
 by(auto simp: start_method_def Method_def fun_upd_apply
         dest!: start_prog_Start_sees_methods)

lemma wf_start_prog_Start_sees_start_method:
assumes wf: "wf_prog wf_md P"
shows "start_prog P C M 
         Start sees start_m, Static : []Void = (1, 0, [Invokestatic C M 0,Return], []) in Start"
proof -
  from wf have "is_class P Object" by simp
  with sees_methods_Object  obtain Mm where "P  Object sees_methods Mm"
   by(fastforce simp: is_class_def dest: sees_methods_Object)
  then show ?thesis by(rule start_prog_Start_sees_start_method)
qed

lemma start_prog_start_m_instrs:
assumes wf: "wf_prog wf_md P"
shows "(instrs_of (start_prog P C M) Start start_m) = [Invokestatic C M 0, Return]"
proof -
  from wf_start_prog_Start_sees_start_method[OF wf]
  have "start_prog P C M  Start sees start_m, Static :
           []Void = (1,0,[Invokestatic C M 0,Return],[]) in Start" by simp
  then show ?thesis by simp
qed

(******************************************************************)

declare wt_defs [simp del]

end

Theory BVSpecTypeSafe

(*  Title:      JinjaDCI/BV/BVSpecTypeSafe.thy

    Author:     Cornelia Pusch, Gerwin Klein, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory BV/BVSpecTypeSafe.thy by Cornelia Pusch and Gerwin Klein
*)


section ‹ BV Type Safety Proof \label{sec:BVSpecTypeSafe} ›

theory BVSpecTypeSafe
imports BVConform StartProg
begin

text ‹
  This theory contains proof that the specification of the bytecode
  verifier only admits type safe programs.  
›

subsection ‹ Preliminaries ›

text ‹
  Simp and intro setup for the type safety proof:
›
lemmas defs1 = correct_state_def conf_f_def wt_instr_def eff_def norm_eff_def app_def xcpt_app_def

lemmas widen_rules [intro] = conf_widen confT_widen confs_widens confTs_widen

  
subsection ‹ Exception Handling ›


text ‹
  For the @{text Invoke} instruction the BV has checked all handlers
  that guard the current @{text pc}.
›
lemma Invoke_handlers:
  "match_ex_table P C pc xt = Some (pc',d')  
  (f,t,D,h,d)  set (relevant_entries P (Invoke n M) pc xt). 
   P  C * D  pc  {f..<t}  pc' = h  d' = d"
  by (induct xt) (auto simp: relevant_entries_def matches_ex_entry_def 
                                 is_relevant_entry_def split: if_split_asm)

text ‹
  For the @{text Invokestatic} instruction the BV has checked all handlers
  that guard the current @{text pc}.
›
lemma Invokestatic_handlers:
  "match_ex_table P C pc xt = Some (pc',d')  
  (f,t,D,h,d)  set (relevant_entries P (Invokestatic C0 n M) pc xt). 
   P  C * D  pc  {f..<t}  pc' = h  d' = d"
  by (induct xt) (auto simp: relevant_entries_def matches_ex_entry_def 
                                 is_relevant_entry_def split: if_split_asm)

text ‹
  For the instrs in @{text Called_set} the BV has checked all handlers
  that guard the current @{text pc}.
›
lemma Called_set_handlers:
  "match_ex_table P C pc xt = Some (pc',d')  i  Called_set 
  (f,t,D,h,d)  set (relevant_entries P i pc xt). 
   P  C * D  pc  {f..<t}  pc' = h  d' = d"
  by (induct xt) (auto simp: relevant_entries_def matches_ex_entry_def 
                                 is_relevant_entry_def split: if_split_asm)

text ‹
  We can prove separately that the recursive search for exception
  handlers (@{text find_handler}) in the frame stack results in 
  a conforming state (if there was no matching exception handler 
  in the current frame). We require that the exception is a valid
  heap address, and that the state before the exception occurred
  conforms. 
›
lemma uncaught_xcpt_correct:
  assumes wt: "wf_jvm_progΦ P"
  assumes h:  "h xcp = Some obj"
  shows "f. P,Φ  (None, h, f#frs, sh)
      curr_method f  clinit  P,Φ  find_handler P xcp h frs sh " 
  (is "f. ?correct (None, h, f#frs, sh)  ?prem f  ?correct (?find frs)")
(*<*)
proof (induct frs) 
  ― ‹the base
 case is trivial as it should be›
  show "?correct (?find [])" by (simp add: correct_state_def)
next
  ― ‹we will need both forms @{text wf_jvm_prog} and @{text wf_prog} later›
  from wt obtain mb where wf: "wf_prog mb P" by (simp add: wf_jvm_prog_phi_def)

  ― ‹the assumptions for the cons case:›
  fix f f' frs' assume cr: "?correct (None, h, f#f'#frs', sh)"
  assume pr: "?prem f"

  ― ‹the induction hypothesis:›
  assume IH: "f. ?correct (None, h, f#frs', sh)  ?prem f  ?correct (?find frs')"

  from cr pr conf_clinit_Cons[where frs="f'#frs'" and f=f] obtain
        confc: "conf_clinit P sh (f'#frs')"
    and cr': "?correct (None, h, f'#frs', sh)" by(fastforce simp: correct_state_def)
    
  obtain stk loc C M pc ics where [simp]: "f' = (stk,loc,C,M,pc,ics)" by (cases f')

  from cr' obtain b Ts T mxs mxl0 ins xt where
    meth: "P  C sees M,b:Ts  T = (mxs,mxl0,ins,xt) in C"
    by (simp add: correct_state_def, blast)

  hence xt[simp]: "ex_table_of P C M = xt" by simp

  have cls: "is_class P C" by(rule sees_method_is_class'[OF meth])
  from cr' obtain sfs where
    sfs: "M = clinit  sh C = Some(sfs,Processing)" by(fastforce simp: defs1 conf_clinit_def)

  show "?correct (?find (f'#frs'))" 
  proof (cases "match_ex_table P (cname_of h xcp) pc xt")
    case None with cr' IH[of f'] show ?thesis
    proof(cases "M=clinit")
      case True then show ?thesis using xt cr' IH[of f'] None h conf_clinit_Called_Throwing
        conf_f_Throwing[where h=h and sh=sh, OF _ cls h sfs]
       by(cases frs', auto simp: correct_state_def image_iff) fastforce
    qed(auto)
  next
    fix pc_d
    assume "match_ex_table P (cname_of h xcp) pc xt = Some pc_d"
    then obtain pc' d' where 
      match: "match_ex_table P (cname_of h xcp) pc xt = Some (pc',d')"
      (is "?match (cname_of h xcp) = _")
      by (cases pc_d) auto 

    from wt meth cr' [simplified]
    have wti: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M" 
      by (fastforce simp: correct_state_def conf_f_def
                   dest: sees_method_fun
                   elim!: wt_jvm_prog_impl_wt_instr)
    
    from cr' obtain ST LT where Φ: "Φ C M ! pc = Some (ST, LT)"
        by(fastforce dest: sees_method_fun simp: correct_state_def)

    from cr' Φ meth have conf': "conf_f P h sh (ST, LT) ins f'"
      by (unfold correct_state_def) (fastforce dest: sees_method_fun)
    hence loc: "P,h  loc [:≤] LT" and 
          stk: "P,h  stk [:≤] ST" by (unfold conf_f_def) auto
    hence [simp]: "size stk = size ST" by (simp add: list_all2_lengthD)

    from cr meth pr
    obtain D n M' where
      ins: "ins!pc = Invoke n M'  ins!pc = Invokestatic D n M'" (is "_ = ?i  _ = ?i'")
      by(fastforce dest: sees_method_fun simp: correct_state_def)
    
    with match obtain f1 t D where
      rel: "(f1,t,D,pc',d')  set (relevant_entries P (ins!pc) pc xt)" and
      D: "P  cname_of h xcp * D"
      by(fastforce dest: Invoke_handlers Invokestatic_handlers)
      
    from rel have 
      "(pc', Some (Class D # drop (size ST - d') ST, LT))  set (xcpt_eff (ins!pc) P pc (ST,LT) xt)"
      (is "(_, Some (?ST',_))  _")
      by (force simp: xcpt_eff_def image_def)      
    with wti Φ obtain 
      pc: "pc' < size ins" and
      "P  Some (?ST', LT) ≤' Φ C M ! pc'"
      by (clarsimp simp: defs1) blast
    then obtain ST' LT' where
      Φ': "Φ C M ! pc' = Some (ST',LT')" and
      less: "P  (?ST', LT) i (ST',LT')"
      by (auto simp: sup_state_opt_any_Some)   

    let ?f = "(Addr xcp # drop (length stk - d') stk, loc, C, M, pc',No_ics)"
    have "conf_f P h sh (ST',LT') ins ?f" 
    proof -
      from wf less loc have "P,h  loc [:≤] LT'" by simp blast
      moreover from D h have "P,h  Addr xcp :≤ Class D" 
        by (simp add: conf_def obj_ty_def case_prod_unfold)
      with less stk
      have "P,h  Addr xcp # drop (length stk - d') stk  [:≤] ST'" 
        by (auto intro!: list_all2_dropI)
      ultimately show ?thesis using pc conf' by(auto simp: conf_f_def)
    qed

    with cr' match Φ' meth pc
    show ?thesis by (unfold correct_state_def)
                    (cases "M=clinit"; fastforce dest: sees_method_fun simp: conf_clinit_def distinct_clinit_def)
  qed
qed
(*>*)

text ‹
  The requirement of lemma @{text uncaught_xcpt_correct} (that
  the exception is a valid reference on the heap) is always met
  for welltyped instructions and conformant states:
›
lemma exec_instr_xcpt_h:
  "  fst (exec_instr (ins!pc) P h stk vars C M pc ics frs sh) = Some xcp;
       P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M;
       P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh) 
   obj. h xcp = Some obj" 
  (is " ?xcpt; ?wt; ?correct   ?thesis")
(*<*)
proof -
  note [simp] = split_beta
  note [split] = if_split_asm option.split_asm 
  
  assume wt: ?wt ?correct
  hence pre: "preallocated h" by (simp add: correct_state_def hconf_def)

  assume xcpt: ?xcpt
  with exec_instr_xcpts have
   opt: "ins!pc = Throw  xcp  {a. x  sys_xcpts. a = addr_of_sys_xcpt x}" by simp

  with pre show ?thesis 
  proof (cases "ins!pc")
    case Throw with xcpt wt pre show ?thesis 
      by (clarsimp iff: list_all2_Cons2 simp: defs1) 
         (auto dest: non_npD simp: is_refT_def elim: preallocatedE)
  qed (auto elim: preallocatedE)
qed
(*>*)

lemma exec_step_xcpt_h:
assumes xcpt: "fst (exec_step P h stk vars C M pc ics frs sh) = Some xcp"
 and ins: "instrs_of P C M = ins"
 and wti: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
 and correct: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
shows "obj. h xcp = Some obj"
proof -
  from correct have pre: "preallocated h" by(simp add: defs1 hconf_def)
  { fix C' Cs assume ics[simp]: "ics = Calling C' Cs"
    with xcpt have "xcp = addr_of_sys_xcpt NoClassDefFoundError"
      by(cases ics, auto simp: split_beta split: init_state.splits if_split_asm)
    with pre have ?thesis using preallocated_def by force
  }
  moreover
  { fix Cs a assume [simp]: "ics = Throwing Cs a"
    with xcpt have eq: "a = xcp" by(cases Cs; simp)

    from correct have "P,h,sh i (C,M,pc,ics)" by(auto simp: defs1)
    with eq have ?thesis by simp
  }
  moreover
  { fix Cs assume ics: "ics = No_ics  ics = Called Cs"
    with exec_instr_xcpt_h[OF _ wti correct] xcpt ins have ?thesis by(cases Cs, auto)
  }
  ultimately show ?thesis by(cases ics, auto)
qed

lemma conf_sys_xcpt:
  "preallocated h; C  sys_xcpts  P,h  Addr (addr_of_sys_xcpt C) :≤ Class C"
  by (auto elim: preallocatedE)

lemma match_ex_table_SomeD:
  "match_ex_table P C pc xt = Some (pc',d')  
  (f,t,D,h,d)  set xt. matches_ex_entry P C pc (f,t,D,h,d)  h = pc'  d=d'"
  by (induct xt) (auto split: if_split_asm)

text ‹
  Finally we can state that, whenever an exception occurs, the
  next state always conforms:
›
lemma xcpt_correct:
  fixes σ' :: jvm_state
  assumes wtp:  "wf_jvm_progΦ P"
  assumes meth: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes wt:   "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes xp:   "fst (exec_step P h stk loc C M pc ics frs sh) = Some xcp"
  assumes s':   "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes correct: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  shows "P,Φ  σ'"
(*<*)
proof -
  from wtp obtain wfmb where wf: "wf_prog wfmb P" 
    by (simp add: wf_jvm_prog_phi_def)

  from meth have ins[simp]: "instrs_of P C M = ins" by simp
  have cls: "is_class P C" by(rule sees_method_is_class[OF meth])
  from correct obtain sfs where
    sfs: "M = clinit  sh C = Some(sfs,Processing)"
     by(auto simp: correct_state_def conf_clinit_def conf_f_def2)

  note conf_sys_xcpt [elim!]
  note xp' = meth s' xp

  from correct meth
  obtain ST LT where
    h_ok:  "P  h " and
    sh_ok:  "P,h s sh " and
    Φ_pc: "Φ C M ! pc = Some (ST, LT)" and
    frame:  "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
    frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
    vics: "P,h,sh i (C,M,pc,ics)"
   by(auto simp: defs1 dest: sees_method_fun)

  from frame obtain 
    stk: "P,h  stk [:≤] ST" and
    loc: "P,h  loc [:≤] LT" and
    pc:  "pc < size ins" 
    by (unfold conf_f_def) auto

  from h_ok have preh: "preallocated h" by (simp add: hconf_def)

  note wtp
  moreover
  from exec_step_xcpt_h[OF xp ins wt correct]
  obtain obj where h: "h xcp = Some obj" by clarify
  moreover note correct
  ultimately
  have fh: "curr_method (stk,loc,C,M,pc,ics)  clinit
     P,Φ  find_handler P xcp h frs sh " by (rule uncaught_xcpt_correct)
  with xp'
  have "M  clinit  Cs a. ics  Throwing Cs a
    match_ex_table P (cname_of h xcp) pc xt = None  ?thesis" 
    (is "?nc  ?t  ?m (cname_of h xcp) = _  _" is "?nc  ?t  ?match = _  _")
    by(cases ics; simp add: split_beta)
  moreover
  from correct xp' conf_clinit_Called_Throwing conf_f_Throwing[where h=h and sh=sh, OF _ cls h sfs]
  have "M = clinit  Cs a. ics  Throwing Cs a
    match_ex_table P (cname_of h xcp) pc xt = None  ?thesis"
    by(cases frs, auto simp: correct_state_def image_iff split_beta) fastforce
  moreover
  { fix pc_d assume "?match = Some pc_d"
    then obtain pc' d' where some_handler: "?match = Some (pc',d')" 
      by (cases pc_d) auto
    
    from stk have [simp]: "size stk = size ST" ..
  
    from wt Φ_pc have
      eff: "(pc', s')set (xcpt_eff (ins!pc) P pc (ST,LT) xt).
             pc' < size ins  P  s' ≤' Φ C M!pc'"
      by (auto simp: defs1)

    from some_handler obtain f t D where
      xt: "(f,t,D,pc',d')  set xt" and
      "matches_ex_entry P (cname_of h xcp) pc (f,t,D,pc',d')"
      by (auto dest: match_ex_table_SomeD)

    hence match: "P  cname_of h xcp * D"  "pc  {f..<t}"
      by (auto simp: matches_ex_entry_def)
    
    { fix C' Cs assume ics: "ics = Calling C' Cs  ics = Called (C'#Cs)"

      let ?stk' = "Addr xcp # drop (length stk - d') stk"
      let ?f = "(?stk', loc, C, M, pc', No_ics)"
      from some_handler xp' ics
      have σ': "σ' = (None, h, ?f#frs, sh)"
        by (cases ics; simp add: split_beta)

      from xp ics have "xcp = addr_of_sys_xcpt NoClassDefFoundError"
        by(cases ics, auto simp: split_beta split: init_state.splits if_split_asm)
      with match preh have conf: "P,h  Addr xcp :≤ Class D" by fastforce

      from correct ics obtain C1 where "Called_context P C1 (ins!pc)"
        by(fastforce simp: correct_state_def conf_f_def2)
      then have "ins!pc  Called_set" by(rule Called_context_Called_set)
      with xt match have "(f,t,D,pc',d')  set (relevant_entries P (ins!pc) pc xt)"
        by(auto simp: relevant_entries_def is_relevant_entry_def)

      with eff obtain ST' LT' where
        Φ_pc': "Φ C M ! pc' = Some (ST', LT')" and
        pc':   "pc' < size ins" and
        less:  "P  (Class D # drop (size ST - d') ST, LT) i (ST', LT')"
        by (fastforce simp: xcpt_eff_def sup_state_opt_any_Some)
  
      with conf loc stk conf_f_def2 frame ics have "conf_f P h sh (ST',LT') ins ?f" 
        by (auto simp: defs1 intro: list_all2_dropI)
      with meth h_ok frames Φ_pc' σ' sh_ok confc ics
      have ?thesis
        by (unfold correct_state_def)
           (auto dest: sees_method_fun conf_clinit_diff' sees_method_is_class; fastforce)
    }
    moreover
    { assume ics: "ics = No_ics  ics = Called []"

      let ?stk' = "Addr xcp # drop (length stk - d') stk"
      let ?f = "(?stk', loc, C, M, pc', No_ics)"
      from some_handler xp' ics
      have σ': "σ' = (None, h, ?f#frs, sh)"
        by (cases ics; simp add: split_beta)
  
      from xp ics obtain
        "(f,t,D,pc',d')  set (relevant_entries P (ins!pc) pc xt)" and
        conf: "P,h  Addr xcp :≤ Class D"
      proof (cases "ins!pc")
        case Return
        with xp ics have False by(cases ics; cases frs, auto simp: split_beta split: if_split_asm)
        then show ?thesis by simp
      next
        case New with xp match 
        have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (simp add: is_relevant_entry_def)
        moreover
        from xp wt correct obtain obj where xcp: "h xcp = Some obj" 
          by (blast dest: exec_step_xcpt_h[OF _ ins])
        ultimately
        show ?thesis using xt match
          by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
      next
        case Getfield with xp ics
        have xcp: "xcp = addr_of_sys_xcpt NullPointer  xcp = addr_of_sys_xcpt NoSuchFieldError
           xcp = addr_of_sys_xcpt IncompatibleClassChangeError"
          by (cases ics; simp add: split_beta split: if_split_asm staticb.splits)
        with Getfield match preh have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (fastforce simp: is_relevant_entry_def)
        with match preh xt xcp
        show ?thesis by(fastforce simp: relevant_entries_def intro: that)
      next
        case Getstatic with xp match 
        have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (simp add: is_relevant_entry_def)
        moreover
        from xp wt correct obtain obj where xcp: "h xcp = Some obj" 
          by (blast dest: exec_step_xcpt_h[OF _ ins])
        ultimately
        show ?thesis using xt match
          by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
      next
        case Putfield with xp ics
        have xcp: "xcp = addr_of_sys_xcpt NullPointer  xcp = addr_of_sys_xcpt NoSuchFieldError
           xcp = addr_of_sys_xcpt IncompatibleClassChangeError"
          by (cases ics; simp add: split_beta split: if_split_asm staticb.splits)
        with Putfield match preh have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (fastforce simp: is_relevant_entry_def)
        with match preh xt xcp
        show ?thesis by (fastforce simp: relevant_entries_def intro: that)
      next
        case Putstatic with xp match 
        have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (simp add: is_relevant_entry_def)
        moreover
        from xp wt correct obtain obj where xcp: "h xcp = Some obj" 
          by (blast dest: exec_step_xcpt_h[OF _ ins])
        ultimately
        show ?thesis using xt match
          by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
      next
        case Checkcast with xp ics
        have [simp]: "xcp = addr_of_sys_xcpt ClassCast" 
          by (cases ics; simp add: split_beta split: if_split_asm)
        with Checkcast match preh have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (simp add: is_relevant_entry_def)
        with match preh xt
        show ?thesis by (fastforce simp: relevant_entries_def intro: that)
      next
        case Invoke with xp match 
        have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (simp add: is_relevant_entry_def)
        moreover
        from xp wt correct obtain obj where xcp: "h xcp = Some obj" 
          by (blast dest: exec_step_xcpt_h[OF _ ins])
        ultimately
        show ?thesis using xt match
          by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
      next
        case Invokestatic with xp match 
        have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (simp add: is_relevant_entry_def)
        moreover
        from xp wt correct obtain obj where xcp: "h xcp = Some obj" 
          by (blast dest: exec_step_xcpt_h[OF _ ins])
        ultimately
        show ?thesis using xt match
          by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
      next
        case Throw with xp match preh 
        have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
          by (simp add: is_relevant_entry_def)
        moreover
        from xp wt correct obtain obj where xcp: "h xcp = Some obj" 
          by (blast dest: exec_step_xcpt_h[OF _ ins])
        ultimately
        show ?thesis using xt match
          by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
      qed(cases ics, (auto)[5])+
  
      with eff obtain ST' LT' where
        Φ_pc': "Φ C M ! pc' = Some (ST', LT')" and
        pc':   "pc' < size ins" and
        less:  "P  (Class D # drop (size ST - d') ST, LT) i (ST', LT')"
        by (fastforce simp: xcpt_eff_def sup_state_opt_any_Some)
  
      with conf loc stk conf_f_def2 frame ics have "conf_f P h sh (ST',LT') ins ?f" 
        by (auto simp: defs1 intro: list_all2_dropI)
      with meth h_ok frames Φ_pc' σ' sh_ok confc ics
      have ?thesis
        by (unfold correct_state_def) (auto dest: sees_method_fun conf_clinit_diff'; fastforce)
    }
    ultimately
    have "Cs a. ics  Throwing Cs a  ?thesis" by(cases ics; metis list.exhaust)
  }
  moreover
  { fix Cs a assume "ics = Throwing Cs a"
    with xp' have ics: "ics = Throwing [] xcp" by(cases Cs; clarsimp)

    let ?frs = "(stk,loc,C,M,pc,No_ics)#frs"

    have eT: "exec_step P h stk loc C M pc (Throwing [] xcp) frs sh = (Some xcp, h, ?frs, sh)"
      by auto
    with xp' ics have σ'_fh: "σ' = find_handler P xcp h ?frs sh" by simp

    from meth have [simp]: "xt = ex_table_of P C M" by simp

    let ?match = "match_ex_table P (cname_of h xcp) pc xt"
  
    { assume clinit: "M = clinit" and None: "?match = None"
      note asms = clinit None

      have "P,Φ |- find_handler P xcp h ?frs sh [ok]"
      proof(cases frs)
       case Nil
        with h_ok sh_ok asms show "P,Φ |- find_handler P xcp h ?frs sh [ok]"
          by(simp add: correct_state_def)
      next
        case [simp]: (Cons f' frs')
        obtain stk' loc' C' M' pc' ics' where
          [simp]: "f' = (stk',loc',C',M',pc',ics')" by(cases f')

        have cls: "is_class P C" by(rule sees_method_is_class[OF meth])
        have shC: "sh C = Some(sfs,Processing)" by(rule sfs[OF clinit])

        from correct obtain b Ts T mxs' mxl0' ins' xt' ST' LT' where
          meth': "P  C' sees M', b :  TsT = (mxs', mxl0', ins', xt') in C'" and
          Φ_pc': "Φ C' M' ! pc' = (ST', LT')" and
          frame': "conf_f P h sh (ST',LT') ins' (stk', loc', C', M', pc', ics')" and
          frames': "conf_fs P h sh Φ C' M' (length Ts) T frs'" and
          confc': "conf_clinit P sh ((stk',loc',C',M',pc',ics')#frs')"
         by(auto dest: conf_clinit_Cons simp: correct_state_def)
  
        from meth' have
          ins'[simp]: "instrs_of P C' M' = ins'"
          and [simp]: "xt' = ex_table_of P C' M'" by simp+

        let ?f' = "case ics' of Called Cs'  (stk',loc',C',M',pc',Throwing (C#Cs') xcp)
                              | _  (stk',loc',C',M',pc',ics')"

        from asms confc have confc_T: "conf_clinit P sh (?f'#frs')"
          by(cases ics', auto simp: conf_clinit_def distinct_clinit_def)

        from asms conf_f_Throwing[where h=h and sh=sh, OF _ cls h shC] frame' have
         frame_T: "conf_f P h sh (ST', LT') ins' ?f'" by(cases ics'; simp)
        with h_ok sh_ok meth' Φ_pc' confc_T frames'
         have "P,Φ |- (None, h, ?f'#frs', sh) [ok]"
          by(cases ics') (fastforce simp: correct_state_def)+

        with asms show ?thesis by(cases ics'; simp)
      qed
    }
    moreover
    { assume asms: "M  clinit" "?match = None"

      from asms uncaught_xcpt_correct[OF wtp h correct]
       have "P,Φ |- find_handler P xcp h frs sh [ok]" by simp
      with asms have "P,Φ |- find_handler P xcp h ?frs sh [ok]" by auto
    }
    moreover
    { fix pc_d assume some_handler: "?match = pc_d"
        (is "?match = pc_d")
      then obtain pc1 d1 where sh': "?match = Some(pc1,d1)" by(cases pc_d, simp)

      let ?stk' = "Addr xcp # drop (length stk - d1) stk"
      let ?f = "(?stk', loc, C, M, pc1, No_ics)"

      from stk have [simp]: "size stk = size ST" ..

      from wt Φ_pc have
        eff: "(pc1, s')set (xcpt_eff (ins!pc) P pc (ST,LT) xt).
               pc1 < size ins  P  s' ≤' Φ C M!pc1"
        by (auto simp: defs1)

      from match_ex_table_SomeD[OF sh'] obtain f t D where
        xt: "(f,t,D,pc1,d1)  set xt" and
        "matches_ex_entry P (cname_of h xcp) pc (f,t,D,pc1,d1)" by auto
  
      hence match: "P  cname_of h xcp * D"  "pc  {f..<t}"
        by (auto simp: matches_ex_entry_def)

      from ics vics obtain C1 where "Called_context P C1 (ins ! pc)" by auto
      then have "ins!pc  Called_set" by(rule Called_context_Called_set)
      with match xt xp ics obtain
        res: "(f,t,D,pc1,d1)  set (relevant_entries P (ins!pc) pc xt)"
       by(auto simp: relevant_entries_def is_relevant_entry_def)

      with h match xt xp ics have conf: "P,h  Addr xcp :≤ Class D"
        by (auto simp: relevant_entries_def conf_def case_prod_unfold)

      with eff res obtain ST1 LT1 where
        Φ_pc1: "Φ C M ! pc1 = Some (ST1, LT1)" and
        pc1:   "pc1 < size ins" and
        less1:  "P  (Class D # drop (size ST - d1) ST, LT) i (ST1, LT1)"
        by (fastforce simp: xcpt_eff_def sup_state_opt_any_Some)
 
      with conf loc stk conf_f_def2 frame ics have frame1: "conf_f P h sh (ST1,LT1) ins ?f" 
        by (auto simp: defs1 intro: list_all2_dropI)

      from Φ_pc1 h_ok sh_ok meth frame1 frames conf_clinit_diff'[OF confc] have
        "P,Φ |- (None, h, ?f # frs, sh) [ok]" by(fastforce simp: correct_state_def)
      with sh' have "P,Φ |- find_handler P xcp h ?frs sh [ok]" by auto
    }
    ultimately
    have cr': "P,Φ |- find_handler P xcp h ?frs sh [ok]" by(cases "?match") blast+

    with σ'_fh have ?thesis by simp
  }
  ultimately
  show ?thesis by (cases "?match") blast+
qed
(*>*)

(**********Non-exception Single-step correctness*************************)
declare defs1 [simp]

subsection ‹ Initialization procedure steps ›

text ‹
  In this section we prove that, for states that result in a step of the
  initialization procedure rather than an instruction execution, the state
  after execution of the step still conforms.
›

lemma Calling_correct:
  fixes σ' :: jvm_state
  assumes wtprog: "wf_jvm_progΦ P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  assumes ics: "ics = Calling C' Cs"

  shows "P,Φ  σ'"
proof -
  from wtprog obtain wfmb where wf: "wf_prog wfmb P" 
    by (simp add: wf_jvm_prog_phi_def)

  from mC cf obtain ST LT where
    h_ok: "P  h " and
    sh_ok: "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    frame:  "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
    vics: "P,h,sh i (C,M,pc,ics)"
    by (fastforce dest: sees_method_fun)

  with ics have confc0: "conf_clinit P sh ((stk,loc,C,M,pc,Calling C' Cs)#frs)" by simp

  from vics ics have cls': "is_class P C'" by auto

  { assume None: "sh C' = None"

    let ?sh = "sh(C'  (sblank P C', Prepared))"

    obtain FDTs where
     flds: "P  C' has_fields FDTs" using wf_Fields_Ex[OF wf cls'] by clarsimp
  
    from shconf_upd_obj[where C=C', OF sh_ok soconf_sblank[OF flds]]
    have sh_ok': "P,h s ?sh " by simp

    from None have "sfs. sh C'  Some(sfs,Processing)" by simp
    with conf_clinit_nProc_dist[OF confc] have
     dist': "distinct (C' # clinit_classes ((stk, loc, C, M, pc, ics) # frs))" by simp
    then have dist'': "distinct (C' # clinit_classes frs)" by simp

    have confc': "conf_clinit P ?sh ((stk, loc, C, M, pc, ics) # frs)"
     by(rule conf_clinit_shupd[OF confc dist'])
    have fs': "conf_fs P h ?sh Φ C M (size Ts) T frs" by(rule conf_fs_shupd[OF fs dist''])
    from vics ics have vics': "P,h,?sh i (C, M, pc, ics)" by auto
  
    from s' ics None have "σ' = (None, h, (stk, loc, C, M, pc, ics)#frs, ?sh)" by auto
  
    with mC h_ok sh_ok' Φ stk loc pc fs' confc vics' confc' frame None
    have ?thesis by fastforce
  }
  moreover
  { fix a assume "sh C' = Some a"
    then obtain sfs i where shC'[simp]: "sh C' = Some(sfs,i)" by(cases a, simp)

    from confc ics have last: "sobj. sh (last(C'#Cs)) = Some sobj"
      by(fastforce simp: conf_clinit_def)

    let "?f" = "λics'. (stk, loc, C, M, pc, ics'::init_call_status)"

    { assume i: "i = Done  i = Processing"
      let ?ics = "Called Cs"

      from last vics ics have vics': "P,h,sh i (C, M, pc, ?ics)" by auto
      from confc ics have confc': "conf_clinit P sh (?f ?ics#frs)"
        by(cases "M=clinit"; clarsimp simp: conf_clinit_def distinct_clinit_def)

      from i s' ics have "σ' = (None, h, ?f ?ics#frs, sh)" by auto

      with mC h_ok sh_ok Φ stk loc pc fs confc' vics' frame ics
      have ?thesis by fastforce
    }
    moreover
    { assume i[simp]: "i = Error"
      let ?a = "addr_of_sys_xcpt NoClassDefFoundError"
      let ?ics = "Throwing Cs ?a"

      from h_ok have preh: "preallocated h" by (simp add: hconf_def)
      then obtain obj where ha: "h ?a = Some obj" by(clarsimp simp: preallocated_def sys_xcpts_def)
      with vics ics have vics': "P,h,sh i (C, M, pc, ?ics)" by auto

      from confc ics have confc'': "conf_clinit P sh (?f ?ics#frs)"
        by(cases "M=clinit"; clarsimp simp: conf_clinit_def distinct_clinit_def)

      from s' ics have σ': "σ' = (None, h, ?f ?ics#frs, sh)" by auto

      from mC h_ok sh_ok Φ stk loc pc fs confc'' vics σ' ics ha
      have ?thesis by fastforce
    }
    moreover
    { assume i[simp]: "i = Prepared"
      let ?sh = "sh(C'  (sfs,Processing))"
      let ?D = "fst(the(class P C'))"
      let ?ics = "if C' = Object then Called (C'#Cs) else Calling ?D (C'#Cs)"

      from shconf_upd_obj[where C=C', OF sh_ok shconfD[OF sh_ok shC']]
      have sh_ok': "P,h s ?sh " by simp

      from cls' have "C'  Object  P  C' * ?D" by(auto simp: is_class_def intro!: subcls1I)
      with is_class_supclass[OF wf _ cls'] have D: "C'   Object  is_class P ?D" by simp

      from i have "sfs. sh C'  Some(sfs,Processing)" by simp
      with conf_clinit_nProc_dist[OF confc0] have
       dist': "distinct (C' # clinit_classes ((stk, loc, C, M, pc, Calling C' Cs) # frs))" by fast
      then have dist'': "distinct (C' # clinit_classes frs)" by simp

      from conf_clinit_shupd_Calling[OF confc0 dist' cls']
           conf_clinit_shupd_Called[OF confc0 dist' cls']
      have confc': "conf_clinit P ?sh (?f ?ics#frs)" by clarsimp
      with last ics have "sobj. ?sh (last(C'#Cs)) = Some sobj"
        by(auto simp: conf_clinit_def fun_upd_apply)
      with D vics ics have vics': "P,h,?sh i (C, M, pc, ?ics)" by auto

      have fs': "conf_fs P h ?sh Φ C M (size Ts) T frs" by(rule conf_fs_shupd[OF fs dist''])

      from frame vics' have frame': "conf_f P h ?sh (ST, LT) ins (?f ?ics)" by simp

      from i s' ics have "σ' = (None, h, ?f ?ics#frs, ?sh)" by(auto simp: if_split_asm)

      with mC h_ok sh_ok' Φ stk loc pc fs' confc' frame' ics
      have ?thesis by fastforce
    }
    ultimately have ?thesis by(cases i, auto)
  }
  ultimately show ?thesis by(cases "sh C'", auto)
qed

lemma Throwing_correct:
  fixes σ' :: jvm_state
  assumes wtprog: "wf_jvm_progΦ P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  assumes ics: "ics = Throwing (C'#Cs) a"

  shows "P,Φ  σ'"
proof -
  from wtprog obtain wfmb where wf: "wf_prog wfmb P" 
    by (simp add: wf_jvm_prog_phi_def)

  from mC cf obtain ST LT where
    h_ok: "P  h " and
    sh_ok: "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    frame:  "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
    vics: "P,h,sh i (C,M,pc,ics)"
    by (fastforce dest: sees_method_fun)

  with ics have confc0: "conf_clinit P sh ((stk,loc,C,M,pc,Throwing (C'#Cs) a)#frs)" by simp

  from frame ics mC have
   cc: "C1. Called_context P C1 (ins ! pc)" by(clarsimp simp: conf_f_def2)

  from frame ics obtain obj where ha: "h a = Some obj" by(auto simp: conf_f_def2)

  from confc ics obtain sfs i where shC': "sh C' = Some(sfs,i)" by(clarsimp simp: conf_clinit_def)
  then have sfs: "P,h,C' s sfs " by(rule shconfD[OF sh_ok])

  from s' ics
  have σ': "σ' = (None, h, (stk,loc,C,M,pc,Throwing Cs a)#frs, sh(C'  (fst(the(sh C')), Error)))"
    (is "σ' = (None, h, ?f'#frs, ?sh')")
   by simp

  from confc ics have dist: "distinct (C' # clinit_classes (?f' # frs))"
    by (simp add: conf_clinit_def distinct_clinit_def)
  then have dist': "distinct (C' # clinit_classes frs)" by simp

  from conf_clinit_Throwing confc ics have confc': "conf_clinit P sh (?f' # frs)" by simp

  from shconf_upd_obj[OF sh_ok sfs] shC' have "P,h s ?sh' " by simp
  moreover
  have "conf_fs P h ?sh' Φ C M (length Ts) T frs" by(rule conf_fs_shupd[OF fs dist'])
  moreover
  have "conf_clinit P ?sh' (?f' # frs)" by(rule conf_clinit_shupd[OF confc' dist])
  moreover note σ' h_ok mC Φ pc stk loc ha cc
  ultimately show "P,Φ  σ' " by fastforce
qed

lemma Called_correct:
  fixes σ' :: jvm_state
  assumes wtprog: "wf_jvm_progΦ P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  assumes ics[simp]: "ics = Called (C'#Cs)"

  shows "P,Φ  σ'"
proof -
  from wtprog obtain wfmb where wf: "wf_prog wfmb P" 
    by (simp add: wf_jvm_prog_phi_def)

  from mC cf obtain ST LT where
    h_ok: "P  h " and
    sh_ok: "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    frame:  "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
    vics: "P,h,sh i (C,M,pc,ics)"
    by (fastforce dest: sees_method_fun)

  then have confc0: "conf_clinit P sh ((stk,loc,C,M,pc,Called (C'#Cs))#frs)" by simp

  from frame mC obtain C1 sobj where
    ss: "Called_context P C1 (ins ! pc)" and
    shC1: "sh C1 = Some sobj"  by(clarsimp simp: conf_f_def2)

  from confc wf_sees_clinit[OF wf] obtain mxs' mxl' ins' xt' where
   clinit: "P  C' sees clinit,Static: []  Void=(mxs',mxl',ins',xt') in C'"
    by(fastforce simp: conf_clinit_def is_class_def)

  let ?loc' = "replicate mxl' undefined"

  from s' clinit
  have σ': "σ' = (None, h, ([],?loc',C',clinit,0,No_ics)#(stk,loc,C,M,pc,Called Cs)#frs, sh)"
    (is "σ' = (None, h, ?if#?f'#frs, sh)")
   by simp

  with wtprog clinit
  obtain start: "wt_start P C' Static [] mxl' (Φ C' clinit)" and ins': "ins'  []"
    by (auto dest: wt_jvm_prog_impl_wt_start)
  then obtain LT0 where LT0: "Φ C' clinit ! 0 = Some ([], LT0)"
    by (clarsimp simp: wt_start_def defs1 sup_state_opt_any_Some split: staticb.splits)
  moreover
  have "conf_f P h sh ([], LT0) ins' ?if"
  proof -
    let ?LT = "replicate mxl' Err"
    have "P,h  ?loc' [:≤] ?LT" by simp
    also from start LT0 have "P   [≤] LT0" by (simp add: wt_start_def)
    finally have "P,h  ?loc' [:≤] LT0" .
    thus ?thesis using ins' by simp
  qed
  moreover
  from conf_clinit_Called confc clinit have "conf_clinit P sh (?if # ?f' # frs)" by simp
  moreover note σ' h_ok sh_ok mC Φ pc stk loc clinit ss shC1 fs
  ultimately show "P,Φ  σ' " by fastforce
qed

subsection ‹ Single Instructions ›

text ‹
  In this section we prove for each single (welltyped) instruction
  that the state after execution of the instruction still conforms.
  Since we have already handled exceptions above, we can now assume that
  no exception occurs in this step. For instructions that may call
  the initialization procedure, we cover the calling and non-calling
  cases separately.
›

lemma Invoke_correct: 
  fixes σ' :: jvm_state
  assumes wtprog: "wf_jvm_progΦ P"
  assumes meth_C: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes ins:    "ins ! pc = Invoke M' n"
  assumes wti:    "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes σ': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes approx: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes no_xcp: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  shows "P,Φ  σ'" 
(*<*)
proof -
  from meth_C approx ins have [simp]: "ics = No_ics" by(cases ics, auto)

  note split_paired_Ex [simp del]
  
  from wtprog obtain wfmb where wfprog: "wf_prog wfmb P" 
    by (simp add: wf_jvm_prog_phi_def)
      
  from ins meth_C approx obtain ST LT where
    heap_ok: "P h" and
    Φ_pc:    "Φ C M!pc = Some (ST,LT)" and
    frame:   "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
    frames:  "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc:   "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
    by (fastforce dest: sees_method_fun)

  from ins wti Φ_pc
  have n: "n < size ST" by simp
  
  { assume "stk!n = Null"
    with ins no_xcp meth_C have False by (simp add: split_beta)
    hence ?thesis ..
  } 
  moreover
  { assume "ST!n = NT"
    moreover 
    from frame have "P,h  stk [:≤] ST" by simp
    with n have "P,h  stk!n :≤ ST!n" by (simp add: list_all2_conv_all_nth)
    ultimately 
    have "stk!n = Null" by simp
    with ins no_xcp meth_C have False by (simp add: split_beta)
    hence ?thesis ..
  } 
  moreover {
    assume NT: "ST!n  NT" and Null: "stk!n  Null"
    
    from NT ins wti Φ_pc obtain D D' b Ts T m ST' LT' where
      D:   "ST!n = Class D" and
      pc': "pc+1 < size ins" and
      m_D: "P  D sees M',b: TsT = m in D'" and
      Ts:  "P  rev (take n ST) [≤] Ts" and
      Φ':  "Φ C M ! (pc+1) = Some (ST', LT')" and
      LT': "P  LT [≤] LT'" and
      ST': "P  (T # drop (n+1) ST) [≤] ST'" and
      b[simp]: "b = NonStatic"
      by (clarsimp simp: sup_state_opt_any_Some)

    from frame obtain 
    stk: "P,h  stk [:≤] ST" and
    loc: "P,h  loc [:≤] LT" by simp
    
    from n stk D have "P,h  stk!n :≤ Class D"
      by (auto simp: list_all2_conv_all_nth)
    with Null obtain a C' fs where
      Addr:   "stk!n = Addr a" and
      obj:    "h a = Some (C',fs)" and
      C'subD: "P  C' * D"
      by (fastforce dest!: conf_ClassD) 

    with wfprog m_D no_xcp
    obtain Ts' T' D'' mxs' mxl' ins' xt' where
      m_C': "P  C' sees M',NonStatic: Ts'T' = (mxs',mxl',ins',xt') in D''" and
      T':   "P  T'  T" and
      Ts':  "P  Ts [≤] Ts'"
      by (auto dest: sees_method_mono)
    with wf_NonStatic_nclinit wtprog have nclinit: "M'  clinit" by(simp add: wf_jvm_prog_phi_def)

    have D''subD': "P  D'' * D'" by(rule sees_method_decl_mono[OF C'subD m_D m_C'])

    let ?loc' = "Addr a # rev (take n stk) @ replicate mxl' undefined"
    let ?f' = "([], ?loc', D'', M', 0, No_ics)"
    let ?f  = "(stk, loc, C, M, pc, ics)"

    from Addr obj m_C' ins σ' meth_C no_xcp
    have s': "σ' = (None, h, ?f' # ?f # frs, sh)" by simp

    from Ts n have [simp]: "size Ts = n" 
      by (auto dest: list_all2_lengthD simp: min_def)
    with Ts' have [simp]: "size Ts' = n" 
      by (auto dest: list_all2_lengthD)

    from m_C' wfprog
    obtain mD'': "P  D'' sees M',NonStatic:Ts'T'=(mxs',mxl',ins',xt') in D''"
      by (fast dest: sees_method_idemp)
    moreover 
    with wtprog 
    obtain start: "wt_start P D'' NonStatic Ts' mxl' (Φ D'' M')" and ins': "ins'  []"
      by (auto dest: wt_jvm_prog_impl_wt_start)    
    then obtain LT0 where LT0: "Φ D'' M' ! 0 = Some ([], LT0)"
      by (clarsimp simp: wt_start_def defs1 sup_state_opt_any_Some split: staticb.splits)
    moreover
    have "conf_f P h sh ([], LT0) ins' ?f'"
    proof -
      let ?LT = "OK (Class D'') # (map OK Ts') @ (replicate mxl' Err)"

      from stk have "P,h  take n stk [:≤] take n ST" ..
      hence "P,h  rev (take n stk) [:≤] rev (take n ST)" by simp
      also note Ts also note Ts' finally
      have "P,h  rev (take n stk) [:≤] map OK Ts'" by simp 
      also
      have "P,h  replicate mxl' undefined [:≤] replicate mxl' Err" 
        by simp
      also from m_C' have "P  C' * D''" by (rule sees_method_decl_above)
      with obj have "P,h  Addr a :≤ Class D''" by (simp add: conf_def)
      ultimately
      have "P,h  ?loc' [:≤] ?LT" by simp
      also from start LT0 have "P   [≤] LT0" by (simp add: wt_start_def)
      finally have "P,h  ?loc' [:≤] LT0" .
      thus ?thesis using ins' nclinit by simp
    qed
    moreover
    have "conf_clinit P sh (?f'#?f#frs)" using conf_clinit_Invoke[OF confc nclinit] by simp
    ultimately
    have ?thesis using s' Φ_pc approx meth_C m_D T' ins D nclinit D''subD'
     by(fastforce dest: sees_method_fun [of _ C])
  }
  ultimately show ?thesis by blast
qed
(*>*)

lemma Invokestatic_nInit_correct: 
  fixes σ' :: jvm_state
  assumes wtprog: "wf_jvm_progΦ P"
  assumes meth_C: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes ins:    "ins ! pc = Invokestatic D M' n" and nclinit: "M'  clinit"
  assumes wti:    "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes σ': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes approx: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes no_xcp: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  assumes cs: "ics = Called []  (ics = No_ics  (sfs. sh (fst(method P D M')) = Some(sfs, Done)))"
  shows "P,Φ  σ'" 
(*<*)
proof -
  note split_paired_Ex [simp del]
  
  from wtprog obtain wfmb where wfprog: "wf_prog wfmb P" 
    by (simp add: wf_jvm_prog_phi_def)
      
  from ins meth_C approx obtain ST LT where
    heap_ok: "P h" and
    Φ_pc:    "Φ C M!pc = Some (ST,LT)" and
    frame:   "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
    frames:  "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc:   "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
    by (fastforce dest: sees_method_fun)

  from ins wti Φ_pc have n: "n  size ST" by simp

  from ins wti Φ_pc obtain D' b Ts T mxs' mxl' ins' xt' ST' LT' where
    pc': "pc+1 < size ins" and
    m_D: "P  D sees M',b: TsT = (mxs',mxl',ins',xt') in D'" and
    Ts:  "P  rev (take n ST) [≤] Ts" and
    Φ':  "Φ C M ! (pc+1) = Some (ST', LT')" and
    LT': "P  LT [≤] LT'" and
    ST': "P  (T # drop n ST) [≤] ST'" and
    b[simp]: "b = Static"
    by (clarsimp simp: sup_state_opt_any_Some)

  from frame obtain 
  stk: "P,h  stk [:≤] ST" and
  loc: "P,h  loc [:≤] LT" by simp

  let ?loc' = "rev (take n stk) @ replicate mxl' undefined"
  let ?f' = "([], ?loc', D', M', 0, No_ics)"
  let ?f  = "(stk, loc, C, M, pc, No_ics)"

  from m_D ins σ' meth_C no_xcp cs
  have s': "σ' = (None, h, ?f' # ?f # frs, sh)" by auto

  from Ts n have [simp]: "size Ts = n"
    by (auto dest: list_all2_lengthD)

  from m_D wfprog b
  obtain mD': "P  D' sees M',Static:TsT=(mxs',mxl',ins',xt') in D'"
    by (fast dest: sees_method_idemp)
  moreover 
  with wtprog
  obtain start: "wt_start P D' Static Ts mxl' (Φ D' M')" and ins': "ins'  []"
    by (auto dest: wt_jvm_prog_impl_wt_start)
  then obtain LT0 where LT0: "Φ D' M' ! 0 = Some ([], LT0)"
    by (clarsimp simp: wt_start_def defs1 sup_state_opt_any_Some split: staticb.splits)
  moreover
  have "conf_f P h sh ([], LT0) ins' ?f'"
  proof -
    let ?LT = "(map OK Ts) @ (replicate mxl' Err)"

    from stk have "P,h  take n stk [:≤] take n ST" ..
    hence "P,h  rev (take n stk) [:≤] rev (take n ST)" by simp
    also note Ts finally
    have "P,h  rev (take n stk) [:≤] map OK Ts" by simp 
    also
    have "P,h  replicate mxl' undefined [:≤] replicate mxl' Err" 
      by simp
    also from m_D have "P  D * D'" by (rule sees_method_decl_above)
    ultimately
    have "P,h  ?loc' [:≤] ?LT" by simp
    also from start LT0 have "P   [≤] LT0" by (simp add: wt_start_def)
    finally have "P,h  ?loc' [:≤] LT0" .
    thus ?thesis using ins' by simp
  qed
  moreover
  have "conf_clinit P sh (?f'#?f#frs)" by(rule conf_clinit_Invoke[OF confc nclinit])
  ultimately
  show ?thesis using s' Φ_pc approx meth_C m_D ins nclinit
    by (fastforce dest: sees_method_fun [of _ C])
qed
(*>*)

lemma Invokestatic_Init_correct: 
  fixes σ' :: jvm_state
  assumes wtprog: "wf_jvm_progΦ P"
  assumes meth_C: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes ins:    "ins ! pc = Invokestatic D M' n" and nclinit: "M'  clinit"
  assumes wti:    "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes σ': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes approx: "P,Φ  (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes no_xcp: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
  assumes nDone: "sfs. sh (fst(method P D M'))  Some(sfs, Done)"
  shows "P,Φ  σ'" 
(*<*)
proof -
  note split_paired_Ex [simp del]
  
  from wtprog obtain wfmb where wfprog: "wf_prog wfmb P" 
    by (simp add: wf_jvm_prog_phi_def)
      
  from ins meth_C approx obtain ST LT where
    heap_ok: "P h" and
    Φ_pc:    "Φ C M!pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and
    frames:  "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc:   "conf_clinit P sh ((stk,loc,C,M,pc,No_ics)#frs)" and
    pc:      "pc < size ins"
    by (fastforce dest: sees_method_fun)

  from ins wti Φ_pc obtain D' b Ts T mxs' mxl' ins' xt' where
    m_D: "P  D sees M',b: TsT = (mxs',mxl',ins',xt') in D'" and
    b[simp]: "b = Static"
    by clarsimp

  let ?f  = "(stk, loc, C, M, pc, Calling D' [])"

  from m_D ins σ' meth_C no_xcp nDone
  have s': "σ' = (None, h, ?f # frs, sh)" by(auto split: init_state.splits)

  have cls: "is_class P D'" by(rule sees_method_is_class'[OF m_D])

  from confc have confc': "conf_clinit P sh (?f#frs)"
    by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
  with s' Φ_pc approx meth_C m_D ins nclinit stk loc pc cls frames
  show ?thesis by(fastforce dest: sees_method_fun [of _ C])
qed
(*>*)

declare list_all2_Cons2 [iff]

lemma Return_correct:
  fixes σ' :: jvm_state
  assumes wt_prog: "wf_jvm_progΦ P"
  assumes meth: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes ins: "ins ! pc = Return"
  assumes wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes correct: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"

  shows "P,Φ  σ'"
(*<*)
proof -
  from meth correct ins have [simp]: "ics = No_ics" by(cases ics, auto)

  from wt_prog 
  obtain wfmb where wf: "wf_prog wfmb P" by (simp add: wf_jvm_prog_phi_def)

  from meth ins s'
  have "frs = []  ?thesis" by (simp add: correct_state_def)
  moreover
  { fix f frs' assume frs': "frs = f#frs'"
    then obtain stk' loc' C' M' pc' ics' where 
      f: "f = (stk',loc',C',M',pc',ics')" by (cases f)

    from correct meth
    obtain ST LT where
      h_ok:   "P  h " and
      sh_ok:   "P,h s sh " and
      Φ_pc: "Φ C M ! pc = Some (ST, LT)" and
      frame:  "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
      frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
      confc: "conf_clinit P sh frs"
      by (auto dest: sees_method_fun conf_clinit_Cons simp: correct_state_def)

    from Φ_pc ins wt
    obtain U ST0 where "ST = U # ST0" "P  U  T"
      by (simp add: wt_instr_def app_def) blast    
    with wf frame 
    have hd_stk: "P,h  hd stk :≤ T" by (auto simp: conf_f_def)

    from f frs' frames meth
    obtain ST' LT' b' Ts'' T'' mxs' mxl0' ins' xt' where
      Φ': "Φ C' M' ! pc' = Some (ST', LT')" and
      meth_C':  "P  C' sees M',b':Ts''T''=(mxs',mxl0',ins',xt') in C'" and
      frame':   "conf_f P h sh (ST',LT') ins' f" and
      conf_fs:  "conf_fs P h sh Φ C' M' (size Ts'') T'' frs'"
     by clarsimp

    from f frame' obtain
      stk': "P,h  stk' [:≤] ST'" and
      loc': "P,h  loc' [:≤] LT'" and
      pc':  "pc' < size ins'"
      by (simp add: conf_f_def)

    { assume b[simp]: "b = NonStatic"

      from wf_NonStatic_nclinit[OF wf] meth have nclinit[simp]: "M  clinit" by simp

      from f frs' meth ins s'
      have σ':
        "σ' = (None,h,(hd stk#(drop (1+size Ts) stk'),loc',C',M',pc'+1,ics')#frs',sh)"
        (is "σ' = (None,h,?f'#frs',sh)")
        by simp
      from f frs' confc conf_clinit_diff have confc'': "conf_clinit P sh (?f'#frs')" by blast
    
      with Φ' meth_C' f frs' frames meth
      obtain D Ts' T' m D' where
        ins': "ins' ! pc' = Invoke M (size Ts)" and
        D: "ST' ! (size Ts) = Class D" and
        meth_D: "P  D sees M,b: Ts'T' = m in D'" and
        T': "P  T  T'" and
        CsubD': "P  C * D'"
       by(auto dest: sees_method_fun sees_method_fun[OF sees_method_idemp])

      from wt_prog meth_C' pc'  
      have "P,T'',mxs',size ins',xt'  ins'!pc',pc' :: Φ C' M'"
        by (rule wt_jvm_prog_impl_wt_instr)
      with ins' Φ' D meth_D
      obtain ST'' LT'' where
        Φ_suc:   "Φ C' M' ! Suc pc' = Some (ST'', LT'')" and
        less:    "P  (T' # drop (size Ts+1) ST', LT') i (ST'', LT'')" and
        suc_pc': "Suc pc' < size ins'" 
        by (clarsimp simp: sup_state_opt_any_Some)
  
      from hd_stk T' have hd_stk': "P,h  hd stk :≤ T'"  ..
  
      have frame'':
        "conf_f P h sh (ST'',LT'') ins' ?f'" 
      proof -
        from stk'
        have "P,h  drop (1+size Ts) stk' [:≤] drop (1+size Ts) ST'" ..
        moreover
        with hd_stk' less
        have "P,h  hd stk # drop (1+size Ts) stk' [:≤] ST''" by auto
        moreover
        from wf loc' less have "P,h  loc' [:≤] LT''" by auto
        moreover note suc_pc' 
        moreover
        from f frs' frames (* ics' = No_ics *)
        have "P,h,sh i (C', M', Suc pc', ics')" by auto
        ultimately show ?thesis by (simp add: conf_f_def)
      qed
  
      with σ' frs' f meth h_ok sh_ok hd_stk Φ_suc frames confc'' meth_C' Φ'
      have ?thesis by(fastforce dest: sees_method_fun [of _ C'])
    }
    moreover
    { assume b[simp]: "b = Static" and nclinit[simp]: "M  clinit"

      from f frs' meth ins s'
      have σ':
        "σ' = (None,h,(hd stk#(drop (size Ts) stk'),loc',C',M',pc'+1,ics')#frs',sh)"
        (is "σ' = (None,h,?f'#frs',sh)")
        by simp
      from f frs' confc conf_clinit_diff have confc'': "conf_clinit P sh (?f'#frs')" by blast

      with Φ' meth_C' f frs' frames meth
      obtain D Ts' T' m where
        ins': "ins' ! pc' = Invokestatic D M (size Ts)" and
        meth_D: "P  D sees M,b: Ts'T' = m in C" and
        T': "P  T  T'"
       by(auto dest: sees_method_fun sees_method_mono2[OF _ wf sees_method_idemp])
      
      from wt_prog meth_C' pc'  
      have "P,T'',mxs',size ins',xt'  ins'!pc',pc' :: Φ C' M'"
        by (rule wt_jvm_prog_impl_wt_instr)
      with ins' Φ' meth_D
      obtain ST'' LT'' where
        Φ_suc:   "Φ C' M' ! Suc pc' = Some (ST'', LT'')" and
        less:    "P  (T' # drop (size Ts) ST', LT') i (ST'', LT'')" and
        suc_pc': "Suc pc' < size ins'" 
        by (clarsimp simp: sup_state_opt_any_Some)
  
      from hd_stk T' have hd_stk': "P,h  hd stk :≤ T'"  ..
  
      have frame'':
        "conf_f P h sh (ST'',LT'') ins' ?f'" 
      proof -
        from stk'
        have "P,h  drop (size Ts) stk' [:≤] drop (size Ts) ST'" ..
        moreover
        with hd_stk' less
        have "P,h  hd stk # drop (size Ts) stk' [:≤] ST''" by auto
        moreover
        from wf loc' less have "P,h  loc' [:≤] LT''" by auto
        moreover note suc_pc' 
        moreover
        from f frs' frames (* ics' = No_ics *)
        have "P,h,sh i (C', M', Suc pc', ics')" by auto
        ultimately show ?thesis by (simp add: conf_f_def)
      qed
  
      with σ' frs' f meth h_ok sh_ok hd_stk Φ_suc frames confc'' meth_C' Φ'
      have ?thesis by(fastforce dest: sees_method_fun [of _ C'])
    }
    moreover
    { assume b[simp]: "b = Static" and clinit[simp]: "M = clinit"

      from frs' meth ins s'
      have σ':
        "σ' = (None,h,frs,sh(C(fst(the(sh C)), Done)))" (is "σ' = (None,h,frs,?sh)")
        by simp

      from correct have dist': "distinct (C # clinit_classes frs)"
        by(simp add: conf_clinit_def distinct_clinit_def)

      from f frs' correct have confc1:
       "conf_clinit P sh ((stk, loc, C, clinit, pc, No_ics) # (stk',loc',C',M',pc',ics') # frs')"
        by simp
      then have ics_dist: "distinct (C # ics_classes ics')"
        by(simp add: conf_clinit_def distinct_clinit_def)

      from conf_clinit_Cons_Cons[OF confc1] have dist'': "distinct (C # clinit_classes frs')"
        by(simp add: conf_clinit_def distinct_clinit_def)

      from correct shconf_upd_obj[OF sh_ok _ [OF shconfD[OF sh_ok]]]
       have sh'_ok: "P,h s ?sh " by(clarsimp simp: conf_clinit_def)

      have frame'':
        "conf_f P h ?sh (ST',LT') ins' f" 
      proof -
        note stk' loc' pc' f valid_ics_shupd[OF _ ics_dist]
        moreover
        from f frs' frames
        have "P,h,sh i (C', M', pc', ics')" by auto
        ultimately show ?thesis by (simp add: conf_f_def2)
      qed
      have conf_fs': "conf_fs P h ?sh Φ C' M' (length Ts'') T'' frs'"
       by(rule conf_fs_shupd[OF conf_fs dist''])

      have confc'': "conf_clinit P ?sh frs" by(rule conf_clinit_shupd[OF confc dist'])

      from σ' f frs' h_ok sh'_ok conf_fs' frame'' Φ' stk' loc' pc' meth_C' confc''
       have ?thesis by(fastforce dest: sees_method_fun)
    }
    ultimately have ?thesis by (cases b) blast+
  }
  ultimately
  show ?thesis by (cases frs) blast+
qed
(*>*)

declare sup_state_opt_any_Some [iff]
declare not_Err_eq [iff]

lemma Load_correct:
" wf_prog wt P;
    P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
    ins!pc = Load idx; 
    P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
    Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh); 
    P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh) 
 P,Φ  σ'"
(*<*)
  apply(subgoal_tac "ics = No_ics")
   prefer 2 apply(cases ics, (auto)[4])
  apply clarsimp 
  apply (drule (1) sees_method_fun)
  apply(fastforce elim!: confTs_confT_sup conf_clinit_diff)
  done
(*>*)

declare [[simproc del: list_to_set_comprehension]]

lemma Store_correct:
" wf_prog wt P;
  P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C;
  ins!pc = Store idx;
  P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M;
  Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh);
  P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh) 
 P,Φ  σ'"
(*<*)
  apply(subgoal_tac "ics = No_ics")
   prefer 2 apply(cases ics, (auto)[4])
  apply clarsimp 
  apply (drule (1) sees_method_fun)
  apply (blast intro!: list_all2_update_cong conf_clinit_diff)+
  done
(*>*)


lemma Push_correct:
" wf_prog wt P;
    P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
    ins!pc = Push v;
    P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
    Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh);
    P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh) 
 P,Φ  σ'" 
(*<*)
  apply(subgoal_tac "ics = No_ics")
   prefer 2 apply(cases ics, (auto)[4])
  apply clarsimp 
  apply (drule (1) sees_method_fun)
  apply (blast dest: typeof_lit_conf conf_clinit_diff)+
  done
(*>*)


lemma Cast_conf2:
  " wf_prog ok P; P,h  v :≤ T; is_refT T; cast_ok P C h v; 
     P  Class C  T'; is_class P C 
   P,h  v :≤ T'"
(*<*)
  apply (unfold cast_ok_def is_refT_def)
  apply (frule Class_widen)
  apply (elim exE disjE) 
     apply simp
    apply simp
   apply simp  
  apply (clarsimp simp: conf_def obj_ty_def)
  apply (cases v)
  apply (auto intro: rtrancl_trans)
  done
(*>*)


lemma Checkcast_correct:
" wf_jvm_progΦ P;
    P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
    ins!pc = Checkcast D; 
    P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
    Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ; 
    P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh);
    fst (exec_step P h stk loc C M pc ics frs sh) = None  
 P,Φ  σ'"
(*<*)
  apply(subgoal_tac "ics = No_ics")
   prefer 2 apply(cases ics, (auto)[4])
  apply (clarsimp simp: wf_jvm_prog_phi_def split: if_split_asm)
  apply (drule (1) sees_method_fun)
  apply (blast intro: Cast_conf2 dest: sees_method_fun conf_clinit_diff)
  done
(*>*)

declare split_paired_All [simp del]

lemmas widens_Cons [iff] = list_all2_Cons1 [of "widen P"] for P

lemma Getfield_correct:
  fixes σ' :: jvm_state
  assumes wf: "wf_prog wt P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes i:  "ins!pc = Getfield F D"
  assumes wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"

  shows "P,Φ  σ'"
(*<*)
proof -
  from mC cf i have [simp]: "ics = No_ics" by(cases ics, auto)

  from mC cf obtain ST LT where    
    "h√": "P  h " and
    "sh√": "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
    by (fastforce dest: sees_method_fun)
       
  from i Φ wt obtain oT ST'' vT ST' LT' vT' where 
    oT: "P  oT  Class D" and
    ST: "ST = oT # ST''" and
    F:  "P  D sees F,NonStatic:vT in D" and
    pc': "pc+1 < size ins"  and
    Φ': "Φ C M ! (pc+1) = Some (vT'#ST', LT')" and
    ST': "P  ST'' [≤] ST'" and LT': "P  LT [≤] LT'" and  
    vT': "P  vT  vT'"
    by fastforce

  from stk ST obtain ref stk' where 
    stk': "stk = ref#stk'" and
    ref:  "P,h  ref :≤ oT" and
    ST'': "P,h  stk' [:≤] ST''"
    by auto

  from stk' i mC s' xc have "ref  Null"
    by (simp add: split_beta split:if_split_asm)
  moreover from ref oT have "P,h  ref :≤ Class D" ..
  ultimately obtain a D' fs where 
    a: "ref = Addr a" and h: "h a = Some (D', fs)" and D': "P  D' * D"
    by (blast dest: non_npD)

  from D' F have has_field: "P  D' has F,NonStatic:vT in D"      
    by (blast intro: has_field_mono has_visible_field)
  moreover from "h√" h have "P,h  (D', fs) " by (rule hconfD)
  ultimately obtain v where v: "fs (F, D) = Some v" "P,h  v :≤ vT"
    by (clarsimp simp: oconf_def has_field_def) 
       (blast dest: has_fields_fun)

  from conf_clinit_diff[OF confc]
   have confc': "conf_clinit P sh ((v#stk',loc,C,M,pc+1,ics)#frs)" by simp

  from a h i mC s' stk' v xc has_field
  have "σ' = (None, h, (v#stk',loc,C,M,pc+1,ics)#frs, sh)"
   by(simp add: split_beta split: if_split_asm)
  moreover
  from ST'' ST' have "P,h  stk' [:≤] ST'" ..
  moreover
  from v vT' have "P,h  v :≤ vT'" by blast
  moreover
  from loc LT' have "P,h  loc [:≤] LT'" ..
  moreover
  note "h√" "sh√" mC Φ' pc' v fs confc'
  ultimately
  show "P,Φ  σ' " by fastforce
qed
(*>*)

lemma Getstatic_nInit_correct:
  fixes σ' :: jvm_state
  assumes wf: "wf_prog wt P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes i:  "ins!pc = Getstatic C' F D"
  assumes wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  assumes cs: "ics = Called []  (ics = No_ics  (sfs. sh (fst(field P D F)) = Some(sfs, Done)))"

  shows "P,Φ  σ'"
(*<*)
proof -
  from mC cf obtain ST LT where    
    "h√": "P  h " and
    "sh√": "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
    vics: "P,h,sh i (C,M,pc,ics)"
    by (fastforce dest: sees_method_fun)

  from i Φ wt cs obtain vT ST' LT' vT' where 
    F:  "P  C' sees F,Static:vT in D" and
    pc': "pc+1 < size ins"  and
    Φ': "Φ C M ! (pc+1) = Some (vT'#ST', LT')" and
    ST': "P  ST [≤] ST'" and LT': "P  LT [≤] LT'" and  
    vT': "P  vT  vT'"
    by fastforce

  with mC i vics obtain sobj where
    cc': "ics = Called []  Called_context P D (ins!pc)  sh D = Some sobj"
   by(fastforce dest: has_visible_field)

  from field_def2[OF sees_field_idemp[OF F]] have D[simp]: "fst(field P D F) = D" by simp
  from cs cc' obtain sfs i where shD: "sh D = Some(sfs,i)" by(cases sobj, auto)

  note has_field_idemp[OF has_visible_field[OF F]]
  moreover from "sh√" shD have "P,h,D s sfs " by (rule shconfD)
  ultimately obtain v where v: "sfs F = Some v" "P,h  v :≤ vT"
    by (clarsimp simp: soconf_def has_field_def) blast

  from i mC s' v xc F cs cc' shD
  have "σ' = (None, h, (v#stk,loc,C,M,pc+1,No_ics)#frs, sh)"
   by(fastforce simp: split_beta split: if_split_asm init_call_status.splits)
  moreover
  from stk ST' have "P,h  stk [:≤] ST'" ..
  moreover
  from v vT' have "P,h  v :≤ vT'" by blast
  moreover
  from loc LT' have "P,h  loc [:≤] LT'" ..
  moreover
  have "conf_clinit P sh ((v#stk,loc,C,M,pc+1,No_ics)#frs)" by(rule conf_clinit_diff'[OF confc])
  moreover
  note "h√" "sh√" mC Φ' pc' v fs
  ultimately
  show "P,Φ  σ' " by fastforce
qed
(*>*)

lemma Getstatic_Init_correct:
  fixes σ' :: jvm_state
  assumes wf: "wf_prog wt P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes i:  "ins!pc = Getstatic C' F D"
  assumes wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
  assumes nDone: "sfs. sh (fst(field P D F))  Some(sfs, Done)"

  shows "P,Φ  σ'"
(*<*)
proof -
  from mC cf obtain ST LT where    
    "h√": "P  h " and
    "sh√": "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,No_ics)#frs)"
   by (fastforce dest: sees_method_fun)

  from i Φ wt nDone obtain vT where 
    F:  "P  C' sees F,Static:vT in D"
    by fastforce
  then have has_field: "P  C' has F,Static:vT in D" by(rule has_visible_field)

  from field_def2[OF sees_field_idemp[OF F]] has_field_is_class'[OF has_field] obtain
    D[simp]: "fst(field P D F) = D" and
    cls: "is_class P D" by simp

  from i mC s' xc F nDone
  have "σ' = (None, h, (stk,loc,C,M,pc,Calling D [])#frs, sh)"
   by(auto simp: split_beta split: if_split_asm init_state.splits)
  moreover
  from confc have "conf_clinit P sh ((stk,loc,C,M,pc,Calling D [])#frs)"
     by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
  moreover
  note loc stk "h√" "sh√" mC Φ pc fs i has_field cls
  ultimately
  show "P,Φ  σ' " by fastforce
qed
(*>*)

lemma Putfield_correct:
  fixes σ' :: jvm_state
  assumes wf: "wf_prog wt P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes i:  "ins!pc = Putfield F D"
  assumes wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"

  shows "P,Φ  σ'"
(*<*)
proof -
  from mC cf i have [simp]: "ics = No_ics" by(cases ics, auto)

  from mC cf obtain ST LT where    
    "h√": "P  h " and      
    "sh√": "P,h s sh " and    
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics) # frs)"
    by (fastforce dest: sees_method_fun)
  
  from i Φ wt obtain vT vT' oT ST'' ST' LT' where 
    ST: "ST = vT # oT # ST''" and
    field: "P  D sees F,NonStatic:vT' in D" and
    oT: "P  oT  Class D" and vT: "P  vT  vT'" and
    pc': "pc+1 < size ins" and 
    Φ': "Φ C M!(pc+1) = Some (ST',LT')" and
    ST': "P  ST'' [≤] ST'" and LT': "P  LT [≤] LT'"
    by clarsimp

  from stk ST obtain v ref stk' where 
    stk': "stk = v#ref#stk'" and
    v:    "P,h  v :≤ vT" and 
    ref:  "P,h  ref :≤ oT" and
    ST'': "P,h  stk' [:≤] ST''"
    by auto

  from stk' i mC s' xc have "ref  Null" by (auto simp: split_beta)
  moreover from ref oT have "P,h  ref :≤ Class D" ..
  ultimately obtain a D' fs where 
    a: "ref = Addr a" and h: "h a = Some (D', fs)" and D': "P  D' * D"
    by (blast dest: non_npD)

  from v vT have vT': "P,h  v :≤ vT'" ..

  from field D' have has_field: "P  D' has F,NonStatic:vT' in D"
    by (blast intro: has_field_mono has_visible_field)

  let ?h' = "h(a(D', fs((F, D)v)))" and ?f' = "(stk',loc,C,M,pc+1,ics)"
  from h have hext: "h  ?h'" by (rule hext_upd_obj)

  have "sh√'": "P,?h' s sh " by(rule shconf_hupd_obj[OF "sh√" h])

  from a h i mC s' stk' has_field field
  have "σ' = (None, ?h', ?f'#frs, sh)" by(simp split: if_split_asm)
  moreover
  from "h√" h have "P,h  (D',fs)" by (rule hconfD) 
  with has_field vT' have "P,h  (D',fs((F, D)v))" ..
  with "h√" h have "P  ?h'" by (rule hconf_upd_obj)
  moreover
  from ST'' ST' have "P,h  stk' [:≤] ST'" ..
  from this hext have "P,?h'  stk' [:≤] ST'" by (rule confs_hext)
  moreover
  from loc LT' have "P,h  loc [:≤] LT'" ..
  from this hext have "P,?h'  loc [:≤] LT'" by (rule confTs_hext)
  moreover
  from fs hext
  have "conf_fs P ?h' sh Φ C M (size Ts) T frs" by (rule conf_fs_hext)
  moreover
  have "conf_clinit P sh (?f' # frs)" by(rule conf_clinit_diff[OF confc])
  moreover
  note mC Φ' pc' "sh√'"
  ultimately
  show "P,Φ  σ' " by fastforce
qed
(*>*)

lemma Putstatic_nInit_correct:
  fixes σ' :: jvm_state
  assumes wf: "wf_prog wt P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes i:  "ins!pc = Putstatic C' F D"
  assumes wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  assumes cs: "ics = Called []  (ics = No_ics  (sfs. sh (fst(field P D F)) = Some(sfs, Done)))"

  shows "P,Φ  σ'"
(*<*)
proof -
  from mC cf obtain ST LT where    
    "h√": "P  h " and
    "sh√": "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
    vics: "P,h,sh i (C,M,pc,ics)"
    by (fastforce dest: sees_method_fun)

  from i Φ wt cs obtain vT vT' ST'' ST' LT' where 
    ST: "ST = vT # ST''" and
    F:  "P  C' sees F,Static:vT' in D" and
    vT: "P  vT  vT'" and
    pc': "pc+1 < size ins"  and
    Φ': "Φ C M ! (pc+1) = Some (ST', LT')" and
    ST': "P  ST'' [≤] ST'" and LT': "P  LT [≤] LT'"
    by fastforce

  from stk ST obtain v stk' where 
    stk': "stk = v#stk'" and
    v:    "P,h  v :≤ vT" and
    ST'': "P,h  stk' [:≤] ST''"
    by auto

  from v vT have vT': "P,h  v :≤ vT'" ..

  with mC i vics obtain sobj where
    cc': "ics = Called []  Called_context P D (ins!pc)  sh D = Some sobj"
   by(fastforce dest: has_visible_field)

  from field_def2[OF sees_field_idemp[OF F]] have D[simp]: "fst(field P D F) = D" by simp
  from cs cc' obtain sfs i where shD: "sh D = Some(sfs,i)" by(cases sobj, auto)

  let ?sh' = "sh(D(sfs(Fv),i))" and ?f' = "(stk',loc,C,M,pc+1,No_ics)"

  have m_D: "P  D has F,Static:vT' in D" by (rule has_field_idemp[OF has_visible_field[OF F]])
  from "sh√" shD have sfs: "P,h,D s sfs " by (rule shconfD)

  have "sh'√": "P,h s ?sh' " by (rule shconf_upd_obj[OF "sh√" soconf_fupd[OF m_D vT' sfs]])

  from i mC s' v xc F cs cc' shD stk'
  have "σ' = (None, h, (stk',loc,C,M,pc+1,No_ics)#frs, ?sh')"
   by(fastforce simp: split_beta split: if_split_asm init_call_status.splits)
  moreover
  from ST'' ST' have "P,h  stk' [:≤] ST'" ..
  moreover
  from loc LT' have "P,h  loc [:≤] LT'" ..
  moreover
  have "conf_fs P h ?sh' Φ C M (size Ts) T frs" by (rule conf_fs_shupd'[OF fs shD])
  moreover
  have "conf_clinit P ?sh' ((stk',loc,C,M,pc+1,No_ics)#frs)"
   by(rule conf_clinit_diff'[OF conf_clinit_shupd'[OF confc shD]])
  moreover
  note "h√" "sh'√" mC Φ' pc' v vT'
  ultimately
  show "P,Φ  σ' " by fastforce
qed
(*>*)

lemma Putstatic_Init_correct:
  fixes σ' :: jvm_state
  assumes wf: "wf_prog wt P"
  assumes mC: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes i:  "ins!pc = Putstatic C' F D"
  assumes wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes cf: "P,Φ  (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes xc: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
  assumes nDone: "sfs. sh (fst(field P D F))  Some(sfs, Done)"

  shows "P,Φ  σ'"
(*<*)
proof -
  from mC cf obtain ST LT where    
    "h√": "P  h " and
    "sh√": "P,h s sh " and
    Φ: "Φ C M ! pc = Some (ST,LT)" and
    stk: "P,h  stk [:≤] ST" and loc: "P,h  loc [:≤] LT" and
    pc: "pc < size ins" and 
    fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc: "conf_clinit P sh ((stk,loc,C,M,pc,No_ics)#frs)"
   by (fastforce dest: sees_method_fun)

  from i Φ wt nDone obtain vT where 
    F:  "P  C' sees F,Static:vT in D"
    by fastforce
  then have has_field: "P  C' has F,Static:vT in D" by(rule has_visible_field)

  from field_def2[OF sees_field_idemp[OF F]] has_field_is_class'[OF has_field] obtain
    D[simp]: "fst(field P D F) = D" and
    cls: "is_class P D" by simp

  from i mC s' xc F nDone
  have "σ' = (None, h, (stk,loc,C,M,pc,Calling D [])#frs, sh)"
   by(auto simp: split_beta split: if_split_asm init_state.splits)
  moreover
  from confc have "conf_clinit P sh ((stk,loc,C,M,pc,Calling D [])#frs)"
     by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
  moreover
  note loc stk "h√" "sh√" mC Φ pc fs i has_field cls
  ultimately
  show "P,Φ  σ' " by fastforce
qed
(*>*)
  
(* FIXME: move *)
lemma oconf_blank2 [intro, simp]:
    "is_class P C; wf_prog wt P  P,h  blank P C "
(*<*)
  by (fastforce simp: oconf_blank dest: wf_Fields_Ex)
(*>*)

lemma obj_ty_blank [iff]: "obj_ty (blank P C) = Class C"
  by (simp add: blank_def)

lemma New_nInit_correct:
  fixes σ' :: jvm_state
  assumes wf:   "wf_prog wt P"
  assumes meth: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes ins:  "ins!pc = New X"
  assumes wt:   "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes exec: "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes conf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
  assumes no_x: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
  assumes cs: "ics = Called []  (ics = No_ics  (sfs. sh X = Some(sfs, Done)))"
  shows "P,Φ  σ'"
(*<*)
proof - 
  from ins conf meth
  obtain ST LT where
    heap_ok: "P h" and
    sheap_ok: "P,h s sh " and
    Φ_pc:    "Φ C M!pc = Some (ST,LT)" and
    frame:   "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
    frames:  "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc:   "conf_clinit P sh ((stk,loc,C,M,pc,ics) # frs)"
    by (auto dest: sees_method_fun)

  from Φ_pc ins wt
  obtain ST' LT' where
    is_class_X: "is_class P X" and
    mxs:       "size ST < mxs" and
    suc_pc:     "pc+1 < size ins" and
    Φ_suc:      "Φ C M!(pc+1) = Some (ST', LT')" and
    less:       "P  (Class X # ST, LT) i (ST', LT')"
    by auto

  from ins no_x cs meth obtain oref where new_Addr: "new_Addr h = Some oref" by auto
  hence h: "h oref = None" by (rule new_Addr_SomeD) 
  
  with exec ins meth new_Addr cs have σ':
    "σ' = (None, h(oref  blank P X), (Addr oref#stk,loc,C,M,pc+1,No_ics)#frs, sh)"
    (is "σ' = (None, ?h', ?f # frs, sh)")
    by auto
  moreover
  from wf h heap_ok is_class_X have h': "P  ?h' "
    by (auto intro: hconf_new)
  moreover
  from h frame less suc_pc wf
  have "conf_f P ?h' sh (ST', LT') ins ?f"
    apply (clarsimp simp: fun_upd_apply conf_def blank_def split_beta)
    apply (auto intro: confs_hext confTs_hext)
    done      
  moreover
  from h have "h  ?h'" by simp
  with frames have "conf_fs P ?h' sh Φ C M (size Ts) T frs" by (rule conf_fs_hext)
  moreover
  have "P,?h' s sh " by(rule shconf_hnew[OF sheap_ok h])
  moreover
  have "conf_clinit P sh (?f # frs)" by(rule conf_clinit_diff'[OF confc])
  ultimately
  show ?thesis using meth Φ_suc by fastforce 
qed
(*>*)

lemma New_Init_correct:
  fixes σ' :: jvm_state
  assumes wf:   "wf_prog wt P"
  assumes meth: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
  assumes ins:  "ins!pc = New X"
  assumes wt:   "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
  assumes exec: "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes conf: "P,Φ  (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
  assumes no_x: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
  assumes nDone: "sfs. sh X  Some(sfs, Done)"
  shows "P,Φ  σ'"
(*<*)
proof - 
  from ins conf meth
  obtain ST LT where
    heap_ok: "P h" and
    sheap_ok: "P,h s sh " and
    Φ_pc:    "Φ C M!pc = Some (ST,LT)" and
    frame:   "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,No_ics)" and
    frames:  "conf_fs P h sh Φ C M (size Ts) T frs" and
    confc:   "conf_clinit P sh ((stk,loc,C,M,pc,No_ics) # frs)"
    by (auto dest: sees_method_fun)

  from Φ_pc ins wt
  obtain ST' LT' where
    is_class_X: "is_class P X" and
    mxs:       "size ST < mxs" and
    suc_pc:     "pc+1 < size ins" and
    Φ_suc:      "Φ C M!(pc+1) = Some (ST', LT')" and
    less:       "P  (Class X # ST, LT) i (ST', LT')"
    by auto
  
  with exec ins meth nDone have σ':
    "σ' = (None, h, (stk,loc,C,M,pc,Calling X [])#frs, sh)"
    (is "σ' = (None, h, ?f # frs, sh)")
    by(auto split: init_state.splits)
  moreover
  from meth frame is_class_X ins
  have "conf_f P h sh (ST, LT) ins ?f" by auto
  moreover note heap_ok sheap_ok frames
  moreover
  from confc have "conf_clinit P sh (?f # frs)"
    by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
  ultimately
  show ?thesis using meth Φ_pc by fastforce 
qed
(*>*)


lemma Goto_correct:
" wf_prog wt P; 
  P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
  ins ! pc = Goto branch; 
  P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
  Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ; 
  P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)  
 P,Φ  σ'"
(*<*)
apply(subgoal_tac "ics = No_ics")
 prefer 2 apply(cases ics, (auto)[4])
apply clarsimp 
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
(*>*)


lemma IfFalse_correct:
" wf_prog wt P; 
  P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
  ins ! pc = IfFalse branch; 
  P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
  Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ; 
  P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)  
 P,Φ  σ'"
(*<*)
apply(subgoal_tac "ics = No_ics")
 prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
(*>*)

lemma CmpEq_correct:
" wf_prog wt P; 
  P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
  ins ! pc = CmpEq;
  P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
  Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ; 
  P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)  
 P,Φ  σ'"
(*<*)
apply(subgoal_tac "ics = No_ics")
 prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
(*>*)

lemma Pop_correct:
" wf_prog wt P; 
  P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
  ins ! pc = Pop;
  P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
  Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ; 
  P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)  
 P,Φ  σ'"
(*<*)
apply(subgoal_tac "ics = No_ics")
 prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
(*>*)


lemma IAdd_correct:
" wf_prog wt P; 
  P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
  ins ! pc = IAdd; 
  P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M; 
  Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ; 
  P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)  
 P,Φ  σ'"
(*<*)
apply(subgoal_tac "ics = No_ics")
 prefer 2 apply(cases ics, (auto)[4])
apply (clarsimp simp: conf_def)
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
(*>*)


lemma Throw_correct:
" wf_prog wt P; 
  P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C; 
  ins ! pc = Throw; 
  Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ; 
  P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh);
  fst (exec_step P h stk loc C M pc ics frs sh) = None  
 P,Φ  σ'"
apply(subgoal_tac "ics = No_ics")
 prefer 2 apply(cases ics, (auto)[4])
apply simp
done

text ‹
  The next theorem collects the results of the sections above,
  i.e.~exception handling, initialization procedure steps, and
  the execution step for each instruction. It states type safety
  for single step execution: in welltyped programs, a conforming
  state is transformed into another conforming state when one
  step of execution is performed.
›
lemma step_correct:
fixes σ' :: jvm_state
assumes wtp: "wf_jvm_progΦ P"
 and meth: "P  C sees M,b:TsT=(mxs,mxl0,ins,xt) in C"
 and exec: "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
 and conf: "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
shows "P,Φ  σ'"
(*<*)
proof -
  from assms have pc: "pc < length ins" by(auto dest: sees_method_fun)
  with wt_jvm_prog_impl_wt_instr[OF wtp meth] have wt: "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
    by simp
  
  from conf obtain ST LT where Φ: "Φ C M ! pc = Some(ST,LT)" by clarsimp

  show ?thesis
  proof(cases "fst (exec_step P h stk loc C M pc ics frs sh)")
    case Some show ?thesis by(rule xcpt_correct[OF wtp meth wt Some exec conf])
  next
    case None
    from wt_jvm_progD[OF wtp] obtain wf_md where wf: "wf_prog wf_md P" by clarify
    
    { assume [simp]: "ics = No_ics"

      from exec conf None obtain
           exec': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
       and conf': "P,Φ  (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
       and None': "fst (exec_step P h stk loc C M pc No_ics frs sh) = None" by simp

      have ?thesis
      proof(cases "ins!pc")
        case Load from Load_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case Store from Store_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case Push from Push_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case (New C) show ?thesis
        proof(cases "sfs. sh C = Some(sfs, Done)")
          case True
          with New_nInit_correct[OF wf meth New wt exec conf None] show ?thesis by simp
        next
          case False
          with New_Init_correct[OF wf meth New wt exec' conf' None'] show ?thesis by simp
        qed
      next
        case Getfield from Getfield_correct[OF wf meth this wt exec conf None]
          show ?thesis by simp
      next
        case (Getstatic C F D) show ?thesis
        proof(cases "sfs. sh (fst (field P D F)) = Some(sfs, Done)")
          case True
          with Getstatic_nInit_correct[OF wf meth Getstatic wt exec conf None] show ?thesis by simp
        next
          case False
          with Getstatic_Init_correct[OF wf meth Getstatic wt exec' conf' None']
           show ?thesis by simp
        qed
      next
        case Putfield from Putfield_correct[OF wf meth this wt exec conf None]
         show ?thesis by simp
      next
        case (Putstatic C F D) show ?thesis
        proof(cases "sfs. sh (fst (field P D F)) = Some(sfs, Done)")
          case True
          with Putstatic_nInit_correct[OF wf meth Putstatic wt exec conf None] show ?thesis by simp
        next
          case False
          with Putstatic_Init_correct[OF wf meth Putstatic wt exec' conf' None']
           show ?thesis by simp
        qed
      next
        case Checkcast from Checkcast_correct[OF wtp meth this wt exec conf None]
          show ?thesis by simp
      next
        case Invoke with Invoke_correct[OF wtp meth this wt exec conf None] show ?thesis by simp
      next
        case (Invokestatic C M n)
        from wf_jvm_prog_nclinit[OF wtp meth wt pc Φ this] have ncl: "M  clinit" by simp
        show ?thesis
        proof(cases "sfs. sh (fst (method P C M)) = Some(sfs, Done)")
          case True
          with Invokestatic_nInit_correct[OF wtp meth Invokestatic ncl wt exec conf None]
           show ?thesis by simp
        next
          case False
          with Invokestatic_Init_correct[OF wtp meth Invokestatic ncl wt exec' conf' None']
           show ?thesis by simp
        qed
      next
        case Return with Return_correct[OF wtp meth this wt exec conf] show ?thesis by simp
      next
        case Pop with Pop_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case IAdd with IAdd_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case Goto with Goto_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case CmpEq with CmpEq_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case IfFalse with IfFalse_correct[OF wf meth this wt exec conf] show ?thesis by simp
      next
        case Throw with Throw_correct[OF wf meth this exec conf None] show ?thesis by simp
      qed
    }
    moreover
    { fix Cs assume [simp]: "ics = Called Cs"
      have ?thesis
      proof(cases Cs)
        case [simp]: Nil
        from conf meth obtain C1 where "Called_context P C1 (ins ! pc)"
         by(clarsimp simp: conf_f_def2 intro!: Called_context_Called_set)
        then have "ins!pc  Called_set" by(rule Called_context_Called_set)
        then show ?thesis
        proof(cases "ins!pc")
          case (New C)
           from New_nInit_correct[OF wf meth this wt exec conf None] show ?thesis by simp
        next
          case (Getstatic C F D)
           from Getstatic_nInit_correct[OF wf meth this wt exec conf None] show ?thesis by simp
        next
          case (Putstatic C F D)
           from Putstatic_nInit_correct[OF wf meth this wt exec conf None] show ?thesis by simp
        next
          case (Invokestatic C M n)
          from wf_jvm_prog_nclinit[OF wtp meth wt pc Φ this] have ncl: "M  clinit" by simp
          with Invokestatic_nInit_correct[OF wtp meth Invokestatic ncl wt exec conf None]
            show ?thesis by simp
        qed(simp_all)
      next
        case (Cons C' Cs') with Called_correct[OF wtp meth exec conf None] show ?thesis by simp
      qed
    }
    moreover
    { fix C' Cs assume [simp]: "ics = Calling C' Cs"
      with Calling_correct[OF wtp meth exec conf None] have ?thesis by simp
    }
    moreover
    { fix Cs a assume [simp]: "ics = Throwing Cs a"
      have ?thesis
      proof(cases Cs)
        case Nil with exec None show ?thesis by simp
      next
        case (Cons C' Cs')
        with Throwing_correct[OF wtp meth exec conf None] show ?thesis by simp
      qed
    }
    ultimately show ?thesis by(cases ics) auto
  qed
qed
(*>*)

subsection ‹ Main ›

lemma correct_state_impl_Some_method:
  "P,Φ  (None, h, (stk,loc,C,M,pc,ics)#frs, sh) 
   b m Ts T. P  C sees M,b:TsT = m in C"
  by fastforce

lemma BV_correct_1 [rule_format]:
"σ.  wf_jvm_progΦ P; P,Φ  σ  P  σ -jvm→1 σ'  P,Φ  σ'"
(*<*)
apply (simp only: split_tupled_all exec_1_iff)
apply (rename_tac xp h frs sh)
apply (case_tac xp)
 apply (case_tac frs)
  apply simp
 apply (simp only: split_tupled_all)
 apply hypsubst
 apply (frule correct_state_impl_Some_method)
 apply clarify
 apply (rule step_correct)
    apply assumption+
  apply (rule sym)
  apply assumption+
apply (case_tac frs)
 apply simp_all
done
(*>*)


theorem progress:
  " xp=None; frs[]   σ'. P  (xp,h,frs,sh) -jvm→1 σ'"
  by (clarsimp simp: exec_1_iff neq_Nil_conv split_beta
               simp del: split_paired_Ex)

lemma progress_conform:
  "wf_jvm_progΦ P; P,Φ  (xp,h,frs,sh); xp=None; frs[] 
   σ'. P  (xp,h,frs,sh) -jvm→1 σ'  P,Φ  σ'"
(*<*)
apply (drule progress)
 apply assumption
apply (fast intro: BV_correct_1)
done
(*>*)

theorem BV_correct [rule_format]:
" wf_jvm_progΦ P; P  σ -jvm→ σ'   P,Φ  σ  P,Φ  σ'"
(*<*)
apply (simp only: exec_all_def1)
apply (erule rtrancl_induct)
 apply simp
apply clarify
apply (erule (2) BV_correct_1)
done
(*>*)

lemma hconf_start:   
  assumes wf: "wf_prog wf_mb P"
  shows "P  (start_heap P) "
(*<*)
  apply (unfold hconf_def)
  apply (simp add: preallocated_start)
  apply (clarify)
  apply (drule sym)
  apply (unfold start_heap_def)
  apply (insert wf)
  apply (auto simp: fun_upd_apply is_class_xcpt split: if_split_asm)
  done
(*>*)

lemma shconf_start:   
  "¬ is_class P Start  P,start_heap P s start_sheap "
(*<*)
  apply (unfold shconf_def)
  apply (clarsimp simp: preallocated_start fun_upd_apply soconf_def has_field_is_class)
  done
(*>*)

lemma BV_correct_initial: 
  shows " wf_jvm_progΦ P; ¬is_class P Start;
     P  C sees M,Static:[]Void = m in C; M  clinit;
     Φ' Start start_m = start_φm 
   start_prog P C M,Φ'  start_state P "
(*<*)
  apply(subgoal_tac "is_class P Object")
   prefer 2 apply(simp add: wf_jvm_prog_phi_def)
  apply(subgoal_tac "Mm. P  Object sees_methods Mm")
   prefer 2 apply(fastforce simp: is_class_def dest: sees_methods_Object)
  apply (cases m)                            
  apply (unfold  start_state_def)
  apply (unfold correct_state_def)
  apply (simp del: defs1)
  apply (rule conjI)
   apply (simp add: wf_jvm_prog_phi_def class_add_hconf_wf[OF _ hconf_start] start_heap_nStart)
  apply (rule conjI)
   using start_prog_start_shconf apply(simp add: wf_jvm_prog_phi_def)
  apply (rule conjI)
   apply(simp add: conf_clinit_def distinct_clinit_def)
  apply (drule wt_jvm_prog_impl_wt_start, assumption+)
  apply (unfold conf_f_def wt_start_def)
  apply (fastforce dest: start_prog_Start_sees_start_method)
  done

declare [[simproc add: list_to_set_comprehension]]
(*>*)

theorem typesafe:
  assumes welltyped:   "wf_jvm_progΦ P"
  assumes nstart:      "¬ is_class P Start"
  assumes main_method: "P  C sees M,Static:[]Void = m in C"
  assumes nclinit:     "M  clinit"
  assumes Φ:           "C. C  Start  Φ' C = Φ C"
  assumes Φ':          "Φ' Start start_m = start_φm" "Φ' Start clinit = start_φm"
  assumes Obj_start_m:
    "(b' Ts' T' m' D'. P  Object sees start_m, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void)"
  shows "start_prog P C M  start_state P -jvm→ σ    start_prog P C M,Φ'  σ "
(*<*)
proof -
  from welltyped nstart main_method nclinit Φ'(1)
  have "start_prog P C M,Φ'  start_state P " by (rule BV_correct_initial)
  moreover
  assume "start_prog P C M  start_state P -jvm→ σ"
  moreover
  from start_prog_wf_jvm_prog_phi[OF welltyped nstart main_method nclinit Φ Φ' Obj_start_m]
   have "wf_jvm_progΦ'(start_prog P C M)" by simp
  ultimately  
  show "start_prog P C M,Φ'  σ " using welltyped by - (rule BV_correct)
qed
(*>*)

end

Theory BVNoTypeError

(*  Title:      JinjaDCI/BV/BVNoTypeErrors.thy

    Author:     Gerwin Klein, Susannah Mansky
    Copyright   GPL

    Based on the Jinja theory BV/BVNoTypeErrors.thy by Gerwin Klein
*)

section ‹ Welltyped Programs produce no Type Errors ›

theory BVNoTypeError
imports "../JVM/JVMDefensive" BVSpecTypeSafe
begin

lemma has_methodI:
  "P  C sees M,b:TsT = m in D  P  C has M,b"
  by (unfold has_method_def) blast

text ‹
  Some simple lemmas about the type testing functions of the
  defensive JVM:
›
lemma typeof_NoneD [simp,dest]: "typeof v = Some x  ¬is_Addr v"
  by (cases v) auto

lemma is_Ref_def2:
  "is_Ref v = (v = Null  (a. v = Addr a))"
  by (cases v) (auto simp add: is_Ref_def)

lemma [iff]: "is_Ref Null" by (simp add: is_Ref_def2)

lemma is_RefI [intro, simp]: "P,h  v :≤ T  is_refT T  is_Ref v"
(*<*)
  apply (cases T)
  apply (auto simp add: is_refT_def is_Ref_def dest: conf_ClassD)
  done
(*>*)

lemma is_IntgI [intro, simp]: "P,h  v :≤ Integer  is_Intg v"
(*<*)
  apply (unfold conf_def)
  apply auto
  done
(*>*)

lemma is_BoolI [intro, simp]: "P,h  v :≤ Boolean  is_Bool v"
(*<*)
  apply (unfold conf_def)
  apply auto
  done
(*>*)

declare defs1 [simp del]

lemma wt_jvm_prog_states_NonStatic:
  " wf_jvm_progΦ P; P  C sees M,NonStatic: TsT = (mxs, mxl, ins, et) in C; 
     Φ C M ! pc = τ; pc < size ins 
   OK τ  states P mxs (1+size Ts+mxl)"
(*<*)
  apply (unfold wf_jvm_prog_phi_def)
  apply (drule (1) sees_wf_mdecl)
  apply (simp add: wf_mdecl_def wt_method_def check_types_def)
  apply (blast intro: nth_in)
  done
(*>*)

lemma wt_jvm_prog_states_Static:
  " wf_jvm_progΦ P; P  C sees M,Static: TsT = (mxs, mxl, ins, et) in C; 
     Φ C M ! pc = τ; pc < size ins 
   OK τ  states P mxs (size Ts+mxl)"
(*<*)
  apply (unfold wf_jvm_prog_phi_def)
  apply (drule (1) sees_wf_mdecl)
  apply (simp add: wf_mdecl_def wt_method_def check_types_def)
  apply (blast intro: nth_in)
  done
(*>*)

text ‹
  The main theorem: welltyped programs do not produce type errors if they
  are started in a conformant state.
›
theorem no_type_error:
  fixes σ :: jvm_state
  assumes welltyped: "wf_jvm_progΦ P" and conforms: "P,Φ  σ "
  shows "exec_d P σ  TypeError"
(*<*)
proof -
  from welltyped obtain mb where wf: "wf_prog mb P" by (fast dest: wt_jvm_progD)
  
  obtain xcp h frs sh where s [simp]: "σ = (xcp, h, frs, sh)" by (cases σ)

  from conforms have "xcp  None  frs = []  check P σ" 
    by (unfold correct_state_def check_def) auto
  moreover {
    assume "¬(xcp  None  frs = [])"
    then obtain stk reg C M pc ics frs' where
      xcp [simp]: "xcp = None" and
      frs [simp]: "frs = (stk,reg,C,M,pc,ics)#frs'" 
      by (clarsimp simp add: neq_Nil_conv)

    from conforms obtain  ST LT b Ts T mxs mxl ins xt where
      hconf:  "P  h " and
      shconf:  "P,h s sh " and
      meth:   "P  C sees M,b:TsT = (mxs, mxl, ins, xt) in C" and
      Φ:      "Φ C M ! pc = Some (ST,LT)" and
      frame:  "conf_f P h sh (ST,LT) ins (stk,reg,C,M,pc,ics)" and
      frames: "conf_fs P h sh Φ C M (size Ts) T frs'"
      by (fastforce simp add: correct_state_def dest: sees_method_fun)
    
    from frame obtain
      stk: "P,h  stk [:≤] ST" and
      reg: "P,h  reg [:≤] LT" and
      pc:  "pc < size ins" 
      by (simp add: conf_f_def)

    from welltyped meth Φ pc
    have "OK (Some (ST, LT))  states P mxs (1+size Ts+mxl)
         OK (Some (ST, LT))  states P mxs (size Ts+mxl)"
      by (cases b, auto dest: wt_jvm_prog_states_NonStatic wt_jvm_prog_states_Static)
    hence "size ST  mxs" by (auto simp add: JVM_states_unfold)
    with stk have mxs: "size stk  mxs" 
      by (auto dest: list_all2_lengthD)

    from welltyped meth pc
    have "P,T,mxs,size ins,xt  ins!pc,pc :: Φ C M"
      by (rule wt_jvm_prog_impl_wt_instr)
    hence app0: "app (ins!pc) P mxs T pc (size ins) xt (Φ C M!pc) "
      by (simp add: wt_instr_def)
    with Φ have eff: 
      "(pc',s')set (eff (ins ! pc) P pc xt (Φ C M ! pc)). pc' < size ins"
      by (unfold app_def) simp

    from app0 Φ have app:
      "xcpt_app (ins!pc) P pc mxs xt (ST,LT)  appi (ins!pc, P, pc, mxs, T, (ST,LT))"
      by (clarsimp simp add: app_def)

    with eff stk reg 
    have "check_instr (ins!pc) P h stk reg C M pc frs' sh"
    proof (cases "ins!pc")
      case (Getfield F C) 
      with app stk reg Φ obtain v vT stk' where
        field: "P  C sees F,NonStatic:vT in C" and
        stk:   "stk = v # stk'" and
        conf:  "P,h  v :≤ Class C"
        by auto
      from conf have is_Ref: "is_Ref v" by auto
      moreover {
        assume "v  Null" 
        with conf field is_Ref wf
        have "D vs. h (the_Addr v) = Some (D,vs)  P  D * C" 
          by (auto dest!: non_npD)
      }
      ultimately show ?thesis using Getfield field stk hconf
        apply clarsimp
        apply (rule conjI, fastforce)
        apply clarsimp
        apply (drule has_visible_field)
        apply (drule (1) has_field_mono)
        apply (drule (1) hconfD)
        apply (unfold oconf_def has_field_def)
        apply clarsimp
        apply (fastforce dest: has_fields_fun)
        done                            
    next
      case (Getstatic C F D) 
      with app stk reg Φ obtain vT where
        field: "P  C sees F,Static:vT in D"
        by auto

        then show ?thesis using Getstatic field stk shconf
        apply clarsimp
        apply (rule conjI, fastforce)
        apply clarsimp
        apply (drule has_visible_field)
        apply (drule has_field_idemp)
        apply (drule (1) shconfD)
        apply (unfold soconf_def has_field_def)
        apply clarsimp
        apply (fastforce dest: has_fields_fun)
        done                            
    next
      case (Putfield F C)
      with app stk reg Φ obtain v ref vT stk' where
        field: "P  C sees F,NonStatic:vT in C" and
        stk:   "stk = v # ref # stk'" and
        confv: "P,h  v :≤ vT" and
        confr: "P,h  ref :≤ Class C"
        by fastforce
      from confr have is_Ref: "is_Ref ref" by simp
      moreover {
        assume "ref  Null" 
        with confr field is_Ref wf
        have "D vs. h (the_Addr ref) = Some (D,vs)  P  D * C"
          by (auto dest: non_npD)
      }
      ultimately show ?thesis using Putfield field stk confv by fastforce
    next
      case (Invoke M' n)
      with app have n: "n < size ST" by simp

      from stk have [simp]: "size stk = size ST" by (rule list_all2_lengthD)
      
      { assume "stk!n = Null" with n Invoke have ?thesis by simp }
      moreover { 
        assume "ST!n = NT"
        with n stk have "stk!n = Null" by (auto simp: list_all2_conv_all_nth)
        with n Invoke have ?thesis by simp
      }
      moreover {
        assume Null: "stk!n  Null" and NT: "ST!n  NT"

        from NT app Invoke
        obtain D D' Ts T m where
          D:  "ST!n = Class D" and
          M': "P  D sees M',NonStatic: TsT = m in D'" and
          Ts: "P  rev (take n ST) [≤] Ts"
          by auto
        
        from D stk n have "P,h  stk!n :≤ Class D" 
          by (auto simp: list_all2_conv_all_nth)
        with Null obtain a C' fs where 
          [simp]: "stk!n = Addr a" "h a = Some (C',fs)" and
          "P  C' * D"
          by (fastforce dest!: conf_ClassD) 

        with M' wf obtain m' Ts' T' D'' where 
          C': "P  C' sees M',NonStatic: Ts'T' = m' in D''" and
          Ts': "P  Ts [≤] Ts'"
          by (auto dest!: sees_method_mono)

        from stk have "P,h  take n stk [:≤] take n ST" ..
        hence "P,h  rev (take n stk) [:≤] rev (take n ST)" ..
        also note Ts also note Ts'
        finally have "P,h  rev (take n stk) [:≤] Ts'" .

        with Invoke Null n C'
        have ?thesis by (auto simp add: is_Ref_def2 has_methodI)
      }
      ultimately show ?thesis by blast
    next
      case (Invokestatic C M' n)
      with app have n: "n  size ST" by simp

      from stk have [simp]: "size stk = size ST" by (rule list_all2_lengthD)

      from app Invokestatic
      obtain D Ts T m where
        M': "P  C sees M',Static: TsT = m in D" and
        Ts: "P  rev (take n ST) [≤] Ts"
        by auto

      from stk have "P,h  take n stk [:≤] take n ST" ..
      hence "P,h  rev (take n stk) [:≤] rev (take n ST)" ..
      also note Ts
      finally have "P,h  rev (take n stk) [:≤] Ts" .

      with Invokestatic n M'
      show ?thesis by (auto simp add: is_Ref_def2 has_methodI)
    next
      case Return
      show ?thesis
      proof(cases "M = clinit")
        case True
        have "is_class P C" by(rule sees_method_is_class[OF meth])
        with wf_sees_clinit[OF wf]
        obtain m where "P  C sees clinit,Static: []  Void = m in C"
         by(fastforce simp: is_class_def)

        with stk app Φ meth frames True Return
        show ?thesis by (auto simp add: has_methodI)
      next
        case False with stk app Φ meth frames Return
        show ?thesis by (auto intro: has_methodI)
      qed
    qed (auto simp add: list_all2_lengthD)
    hence "check P σ" using meth pc mxs by (auto simp: check_def intro: has_methodI)
  } ultimately
  have "check P σ" by blast
  thus "exec_d P σ  TypeError" ..
qed
(*>*)


text ‹
  The theorem above tells us that, in welltyped programs, the
  defensive machine reaches the same result as the aggressive
  one (after arbitrarily many steps).
›
theorem welltyped_aggressive_imp_defensive:
  "wf_jvm_progΦ P  P,Φ  σ   P  σ -jvm→ σ'
   P  (Normal σ) -jvmd→ (Normal σ')"
(*<*)
  apply (simp only: exec_all_def) 
  apply (erule rtrancl_induct)
   apply (simp add: exec_all_d_def1)
  apply simp
  apply (simp only: exec_all_def [symmetric])
  apply (frule BV_correct, assumption+) 
  apply (drule no_type_error, assumption, drule no_type_error_commutes, simp)
  apply (simp add: exec_all_d_def1)
  apply (rule rtrancl_trans, assumption)
  apply (drule exec_1_d_NormalI)
  apply auto
  done
(*>*)


text ‹
  As corollary we get that the aggressive and the defensive machine
  are equivalent for welltyped programs (if started in a conformant
  state or in the canonical start state)
› 
corollary welltyped_commutes:
  fixes σ :: jvm_state
  assumes wf: "wf_jvm_progΦ P" and conforms: "P,Φ  σ " 
  shows "P  (Normal σ) -jvmd→ (Normal σ') = P  σ -jvm→ σ'"
  apply rule
   apply (erule defensive_imp_aggressive)
  apply (erule welltyped_aggressive_imp_defensive [OF wf conforms])
  done

corollary welltyped_initial_commutes:
  assumes wf: "wf_jvm_prog P"
  assumes nstart: "¬ is_class P Start"
  assumes meth: "P  C sees M,Static:[]Void = b in C" 
  assumes nclinit: "M  clinit"
  assumes Obj_start_m:
    "(b' Ts' T' m' D'. P  Object sees start_m, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void)"
  defines start: "σ  start_state P"
  shows "start_prog P C M  (Normal σ) -jvmd→ (Normal σ') = start_prog P C M  σ -jvm→ σ'"
proof -
  from wf obtain Φ where wf': "wf_jvm_progΦ P" by (auto simp: wf_jvm_prog_def)
  let  = "Φ_start Φ"
  from start_prog_wf_jvm_prog_phi[where Φ'="", OF wf' nstart meth nclinit Φ_start Obj_start_m]
   have "wf_jvm_prog(start_prog P C M)" by simp
  moreover
  from wf' nstart meth nclinit Φ_start(2) have "start_prog P C M,  σ "
    unfolding start by (rule BV_correct_initial)
  ultimately show ?thesis by (rule welltyped_commutes)
qed


lemma not_TypeError_eq [iff]:
  "x  TypeError = (t. x = Normal t)"
  by (cases x) auto

locale cnf =
  fixes P and Φ and σ
  assumes wf: "wf_jvm_progΦ P"  
  assumes cnf: "correct_state P Φ σ" 

theorem (in cnf) no_type_errors:
  "P  (Normal σ) -jvmd→ σ'  σ'  TypeError"
  apply (unfold exec_all_d_def1)   
  apply (erule rtrancl_induct)
   apply simp
  apply (fold exec_all_d_def1)
  apply (insert cnf wf)
  apply clarsimp
  apply (drule defensive_imp_aggressive)
  apply (frule (2) BV_correct)
  apply (auto simp add: exec_1_d_eq dest: no_type_error)
  done

locale start =
  fixes P and C and M and σ and T and b and P0
  assumes wf: "wf_jvm_prog P"
  assumes nstart: "¬ is_class P Start"
  assumes sees: "P  C sees M,Static:[]Void = b in C" 
  assumes nclinit: "M  clinit"
  assumes Obj_start_m: "(b' Ts' T' m' D'. P  Object sees start_m, b' :  Ts'T' = m' in D'
          b' = Static  Ts' = []  T' = Void)"
  defines "σ  Normal (start_state P)"
  defines [simp]: "P0  start_prog P C M"

corollary (in start) bv_no_type_error:
  shows "P0  σ -jvmd→ σ'  σ'  TypeError"
proof -
  from wf obtain Φ where wf': "wf_jvm_progΦ P" by (auto simp: wf_jvm_prog_def)
  let  = "Φ_start Φ"
  from start_prog_wf_jvm_prog_phi[where Φ'="", OF wf' nstart sees nclinit Φ_start Obj_start_m]
   have "wf_jvm_progP0" by simp
  moreover
  from BV_correct_initial[where Φ'="", OF wf' nstart sees nclinit Φ_start(2)]
  have "correct_state P0  (start_state P)" by simp
  ultimately have "cnf P0  (start_state P)" by (rule cnf.intro)
  moreover assume "P0  σ -jvmd→ σ'"
  ultimately show ?thesis by (unfold σ_def) (rule cnf.no_type_errors) 
qed

 
end  

Theory J1

(*  Title:      JinjaDCI/Compiler/J1.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Compiler/J1.thy by Tobias Nipkow
*)

chapter ‹ Compilation \label{cha:comp} ›

section ‹ An Intermediate Language ›

theory J1 imports "../J/BigStep" begin

type_synonym expr1 = "nat exp"
type_synonym J1_prog = "expr1 prog"
type_synonym state1 = "heap × (val list) × sheap"

definition hp1 :: "state1  heap"
where
  "hp1    fst"
definition lcl1 :: "state1  val list"
where
  "lcl1    fst  snd"
definition shp1 :: "state1  sheap"
where
  "shp1    snd  snd"

(*<*)
declare hp1_def[simp] lcl1_def[simp] shp1_def[simp]
(*>*)

primrec
  max_vars :: "'a exp  nat"
  and max_varss :: "'a exp list  nat"
where
  "max_vars(new C) = 0"
| "max_vars(Cast C e) = max_vars e"
| "max_vars(Val v) = 0"
| "max_vars(e1 «bop» e2) = max (max_vars e1) (max_vars e2)"
| "max_vars(Var V) = 0"
| "max_vars(V:=e) = max_vars e"
| "max_vars(eF{D}) = max_vars e"
| "max_vars(CsF{D}) = 0"
| "max_vars(FAss e1 F D e2) = max (max_vars e1) (max_vars e2)"
| "max_vars(SFAss C F D e2) = max_vars e2"
| "max_vars(eM(es)) = max (max_vars e) (max_varss es)"
| "max_vars(CsM(es)) = max_varss es"
| "max_vars({V:T; e}) = max_vars e + 1"
| "max_vars(e1;;e2) = max (max_vars e1) (max_vars e2)"
| "max_vars(if (e) e1 else e2) =
   max (max_vars e) (max (max_vars e1) (max_vars e2))"
| "max_vars(while (b) e) = max (max_vars b) (max_vars e)"
| "max_vars(throw e) = max_vars e"
| "max_vars(try e1 catch(C V) e2) = max (max_vars e1) (max_vars e2 + 1)"
| "max_vars(INIT C (Cs,b)  e) = max_vars e"
| "max_vars(RI(C,e);Cs  e') = max (max_vars e) (max_vars e')"

| "max_varss [] = 0"
| "max_varss (e#es) = max (max_vars e) (max_varss es)"

inductive
  eval1 :: "J1_prog  expr1  state1  expr1  state1  bool"
          ("_ 1 ((1_,/_) / (1_,/_))" [51,0,0,0,0] 81)
  and evals1 :: "J1_prog  expr1 list  state1  expr1 list  state1  bool"
           ("_ 1 ((1_,/_) [⇒]/ (1_,/_))" [51,0,0,0,0] 81)
  for P :: J1_prog
where

  New1:
  " sh C = Some (sfs, Done); new_Addr h = Some a;
     P  C has_fields FDTs; h' = h(ablank P C) 
   P 1 new C,(h,l,sh)  addr a,(h',l,sh)"
| NewFail1:
  " sh C = Some (sfs, Done); new_Addr h = None  
  P 1 new C, (h,l,sh)  THROW OutOfMemory,(h,l,sh)"
| NewInit1:
  " sfs. sh C = Some (sfs, Done); P 1 INIT C ([C],False)  unit,(h,l,sh)  Val v',(h',l',sh');
     new_Addr h' = Some a; P  C has_fields FDTs; h'' = h'(ablank P C) 
   P 1 new C,(h,l,sh)  addr a,(h'',l',sh')"
| NewInitOOM1:
  " sfs. sh C = Some (sfs, Done); P 1 INIT C ([C],False)  unit,(h,l,sh)  Val v',(h',l',sh');
     new_Addr h' = None; is_class P C 
   P 1 new C,(h,l,sh)  THROW OutOfMemory,(h',l',sh')"
| NewInitThrow1:
  " sfs. sh C = Some (sfs, Done); P 1 INIT C ([C],False)  unit,(h,l,sh)  throw a,s';
     is_class P C 
   P 1 new C,(h,l,sh)  throw a,s'"

| Cast1:
  " P 1 e,s0  addr a,(h,l,sh); h a = Some(D,fs); P  D * C 
   P 1 Cast C e,s0  addr a,(h,l,sh)"
| CastNull1:
  "P 1 e,s0  null,s1 
  P 1 Cast C e,s0  null,s1"
| CastFail1:
  " P 1 e,s0  addr a,(h,l,sh); h a = Some(D,fs); ¬ P  D * C 
   P 1 Cast C e,s0  THROW ClassCast,(h,l,sh)"
| CastThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 Cast C e,s0  throw e',s1"

| Val1:
  "P 1 Val v,s  Val v,s"

| BinOp1:
  " P 1 e1,s0  Val v1,s1; P 1 e2,s1  Val v2,s2; binop(bop,v1,v2) = Some v 
   P 1 e1 «bop» e2,s0  Val v,s2"
| BinOpThrow11:
  "P 1 e1,s0  throw e,s1 
  P 1 e1 «bop» e2, s0  throw e,s1"
| BinOpThrow21:
  " P 1 e1,s0  Val v1,s1; P 1 e2,s1  throw e,s2 
   P 1 e1 «bop» e2,s0  throw e,s2"

| Var1:
  " ls!i = v; i < size ls  
  P 1 Var i,(h,ls,sh)  Val v,(h,ls,sh)"

| LAss1:
  " P 1 e,s0  Val v,(h,ls,sh); i < size ls; ls' = ls[i := v] 
   P 1 i:= e,s0  unit,(h,ls',sh)"
| LAssThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 i:= e,s0  throw e',s1"

| FAcc1:
  " P 1 e,s0  addr a,(h,ls,sh); h a = Some(C,fs);
     P  C has F,NonStatic:t in D;
     fs(F,D) = Some v 
   P 1 eF{D},s0  Val v,(h,ls,sh)"
| FAccNull1:
  "P 1 e,s0  null,s1 
  P 1 eF{D},s0  THROW NullPointer,s1"
| FAccThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 eF{D},s0  throw e',s1"
| FAccNone1:
  " P 1 e,s0  addr a,(h,ls,sh); h a = Some(C,fs);
    ¬(b t. P  C has F,b:t in D) 
   P 1 eF{D},s0  THROW NoSuchFieldError,(h,ls,sh)"
| FAccStatic1:
  " P 1 e,s0  addr a,(h,ls,sh); h a = Some(C,fs);
    P  C has F,Static:t in D 
   P 1 eF{D},s0  THROW IncompatibleClassChangeError,(h,ls,sh)"

| SFAcc1:
  " P  C has F,Static:t in D;
     sh D = Some (sfs,Done);
     sfs F = Some v 
   P 1 CsF{D},(h,ls,sh)  Val v,(h,ls,sh)"
| SFAccInit1:
  " P  C has F,Static:t in D;
     sfs. sh D = Some (sfs,Done); P 1 INIT D ([D],False)  unit,(h,ls,sh)  Val v',(h',ls',sh');
     sh' D = Some (sfs,i);
     sfs F = Some v 
   P 1 CsF{D},(h,ls,sh)  Val v,(h',ls',sh')"
| SFAccInitThrow1:
  " P  C has F,Static:t in D;
     sfs. sh D = Some (sfs,Done); P 1 INIT D ([D],False)  unit,(h,ls,sh)  throw a,s' 
   P 1 CsF{D},(h,ls,sh)  throw a,s'"
| SFAccNone1:
  " ¬(b t. P  C has F,b:t in D) 
   P 1 CsF{D},s  THROW NoSuchFieldError,s"
| SFAccNonStatic1:
  " P  C has F,NonStatic:t in D 
   P 1 CsF{D},s  THROW IncompatibleClassChangeError,s"


| FAss1:
  " P 1 e1,s0  addr a,s1; P 1 e2,s1  Val v,(h2,l2,sh2);
     h2 a = Some(C,fs); P  C has F,NonStatic:t in D;
     fs' = fs((F,D)v); h2' = h2(a(C,fs')) 
   P 1 e1F{D}:=e2,s0  unit,(h2',l2,sh2)"
| FAssNull1:
  " P 1 e1,s0  null,s1;  P 1 e2,s1  Val v,s2  
  P 1 e1F{D}:=e2,s0  THROW NullPointer,s2"
| FAssThrow11:
  "P 1 e1,s0  throw e',s1 
  P 1 e1F{D}:=e2,s0  throw e',s1"
| FAssThrow21:
  " P 1 e1,s0  Val v,s1; P 1 e2,s1  throw e',s2 
   P 1 e1F{D}:=e2,s0  throw e',s2"
| FAssNone1:
  " P 1 e1,s0  addr a,s1; P 1 e2,s1  Val v,(h2,l2,sh2);
     h2 a = Some(C,fs); ¬(b t. P  C has F,b:t in D) 
   P 1 e1F{D}:=e2,s0  THROW NoSuchFieldError,(h2,l2,sh2)"
| FAssStatic1:
  " P 1 e1,s0  addr a,s1; P 1 e2,s1  Val v,(h2,l2,sh2);
     h2 a = Some(C,fs); P  C has F,Static:t in D 
   P 1 e1F{D}:=e2,s0  THROW IncompatibleClassChangeError,(h2,l2,sh2)"

| SFAss1:
  " P 1 e2,s0  Val v,(h1,l1,sh1);
     P  C has F,Static:t in D;
     sh1 D = Some(sfs,Done); sfs' = sfs(Fv); sh1' = sh1(D(sfs',Done)) 
   P 1 CsF{D}:=e2,s0  unit,(h1,l1,sh1')"
| SFAssInit1:
  " P 1 e2,s0  Val v,(h1,l1,sh1);
     P  C has F,Static:t in D;
     sfs. sh1 D = Some(sfs,Done); P 1 INIT D ([D],False)  unit,(h1,l1,sh1)  Val v',(h',l',sh');
     sh' D = Some(sfs,i);
     sfs' = sfs(Fv); sh'' = sh'(D(sfs',i)) 
   P 1 CsF{D}:=e2,s0  unit,(h',l',sh'')"
| SFAssInitThrow1:
  " P 1 e2,s0  Val v,(h1,l1,sh1);
     P  C has F,Static:t in D;
     sfs. sh1 D = Some(sfs,Done); P 1 INIT D ([D],False)  unit,(h1,l1,sh1)  throw a,s' 
   P 1 CsF{D}:=e2,s0  throw a,s'"
| SFAssThrow1:
  "P 1 e2,s0  throw e',s2
   P 1 CsF{D}:=e2,s0  throw e',s2"
| SFAssNone1:
  " P 1 e2,s0  Val v,(h2,l2,sh2);
    ¬(b t. P  C has F,b:t in D) 
   P 1 CsF{D}:=e2,s0  THROW NoSuchFieldError,(h2,l2,sh2)"
| SFAssNonStatic1:
  " P 1 e2,s0  Val v,(h2,l2,sh2);
    P  C has F,NonStatic:t in D 
   P 1 CsF{D}:=e2,s0  THROW IncompatibleClassChangeError,(h2,l2,sh2)"

| CallObjThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 eM(es),s0  throw e',s1"
| CallNull1:
  " P 1 e,s0  null,s1; P 1 es,s1 [⇒] map Val vs,s2 
   P 1 eM(es),s0  THROW NullPointer,s2"
| Call1:
  " P 1 e,s0  addr a,s1; P 1 es,s1 [⇒] map Val vs,(h2,ls2,sh2);
    h2 a = Some(C,fs); P  C sees M,NonStatic:TsT = body in D;
    size vs = size Ts; ls2' = (Addr a) # vs @ replicate (max_vars body) undefined;
    P 1 body,(h2,ls2',sh2)  e',(h3,ls3,sh3) 
   P 1 eM(es),s0  e',(h3,ls2,sh3)"
| CallParamsThrow1:
  " P 1 e,s0  Val v,s1; P 1 es,s1 [⇒] es',s2;
     es' = map Val vs @ throw ex # es2 
    P 1 eM(es),s0  throw ex,s2"
| CallNone1:
  " P 1 e,s0  addr a,s1;  P 1 ps,s1 [⇒] map Val vs,(h2,ls2,sh2);
     h2 a = Some(C,fs); ¬(b Ts T body D. P  C sees M,b:TsT = body in D) 
   P 1 eM(ps),s0  THROW NoSuchMethodError,(h2,ls2,sh2)"
| CallStatic1:
  " P 1 e,s0  addr a,s1;  P 1 ps,s1 [⇒] map Val vs,(h2,ls2,sh2);
     h2 a = Some(C,fs); P  C sees M,Static:TsT = body in D 
   P 1 eM(ps),s0  THROW IncompatibleClassChangeError,(h2,ls2,sh2)"

| SCallParamsThrow1:
  " P 1 es,s0 [⇒] es',s2; es' = map Val vs @ throw ex # es2 
    P 1 CsM(es),s0  throw ex,s2"
| SCallNone1:
  " P 1 ps,s0 [⇒] map Val vs,s2;
     ¬(b Ts T body D. P  C sees M,b:TsT = body in D) 
   P 1 CsM(ps),s0  THROW NoSuchMethodError,s2"
| SCallNonStatic1:
  " P 1 ps,s0 [⇒] map Val vs,s2;
     P  C sees M,NonStatic:TsT = body in D 
   P 1 CsM(ps),s0  THROW IncompatibleClassChangeError,s2"
| SCallInitThrow1:
  " P 1 ps,s0 [⇒] map Val vs,(h1,ls1,sh1);
     P  C sees M,Static:TsT = body in D;
     sfs. sh1 D = Some(sfs,Done); M  clinit;
     P 1 INIT D ([D],False)  unit,(h1,ls1,sh1)  throw a,s' 
   P 1 CsM(ps),s0  throw a,s'"
| SCallInit1:
  " P 1 ps,s0 [⇒] map Val vs,(h1,ls1,sh1);
     P  C sees M,Static:TsT = body in D;
     sfs. sh1 D = Some(sfs,Done); M  clinit;
     P 1 INIT D ([D],False)  unit,(h1,ls1,sh1)  Val v',(h2,ls2,sh2);
     size vs = size Ts; ls2' = vs @ replicate (max_vars body) undefined;
     P 1 body,(h2,ls2',sh2)  e',(h3,ls3,sh3) 
   P 1 CsM(ps),s0  e',(h3,ls2,sh3)"
| SCall1:
  " P 1 ps,s0 [⇒] map Val vs,(h2,ls2,sh2);
     P  C sees M,Static:TsT = body in D;
     sh2 D = Some(sfs,Done)  (M = clinit  sh2 D = (sfs, Processing));
     size vs = size Ts; ls2' = vs @ replicate (max_vars body) undefined;
     P 1 body,(h2,ls2',sh2)  e',(h3,ls3,sh3) 
   P 1 CsM(ps),s0  e',(h3,ls2,sh3)"

| Block1:
  "P 1 e,s0  e',s1  P 1 Block i T e,s0  e',s1"

| Seq1:
  " P 1 e0,s0  Val v,s1; P 1 e1,s1  e2,s2 
   P 1 e0;;e1,s0  e2,s2"
| SeqThrow1:
  "P 1 e0,s0  throw e,s1 
  P 1 e0;;e1,s0  throw e,s1"

| CondT1:
  " P 1 e,s0  true,s1; P 1 e1,s1  e',s2 
   P 1 if (e) e1 else e2,s0  e',s2"
| CondF1:
  " P 1 e,s0  false,s1; P 1 e2,s1  e',s2 
   P 1 if (e) e1 else e2,s0  e',s2"
| CondThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 if (e) e1 else e2, s0  throw e',s1"

| WhileF1:
  "P 1 e,s0  false,s1 
  P 1 while (e) c,s0  unit,s1"
| WhileT1:
  " P 1 e,s0  true,s1; P 1 c,s1  Val v1,s2;
    P 1 while (e) c,s2  e3,s3 
   P 1 while (e) c,s0  e3,s3"
| WhileCondThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 while (e) c,s0  throw e',s1"
| WhileBodyThrow1:
  " P 1 e,s0  true,s1; P 1 c,s1  throw e',s2
   P 1 while (e) c,s0  throw e',s2"

| Throw1:
  "P 1 e,s0  addr a,s1 
  P 1 throw e,s0  Throw a,s1"
| ThrowNull1:
  "P 1 e,s0  null,s1 
  P 1 throw e,s0  THROW NullPointer,s1"
| ThrowThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 throw e,s0  throw e',s1"

| Try1:
  "P 1 e1,s0  Val v1,s1 
  P 1 try e1 catch(C i) e2,s0  Val v1,s1"
| TryCatch1:
  " P 1 e1,s0  Throw a,(h1,ls1,sh1);
    h1 a = Some(D,fs); P  D * C; i < length ls1;
    P 1 e2,(h1,ls1[i:=Addr a],sh1)  e2',(h2,ls2,sh2) 
   P 1 try e1 catch(C i) e2,s0  e2',(h2,ls2,sh2)"
| TryThrow1:
  " P 1 e1,s0  Throw a,(h1,ls1,sh1); h1 a = Some(D,fs); ¬ P  D * C 
   P 1 try e1 catch(C i) e2,s0  Throw a,(h1,ls1,sh1)"

| Nil1:
  "P 1 [],s [⇒] [],s"

| Cons1:
  " P 1 e,s0  Val v,s1; P 1 es,s1 [⇒] es',s2 
   P 1 e#es,s0 [⇒] Val v # es',s2"
| ConsThrow1:
  "P 1 e,s0  throw e',s1 
  P 1 e#es,s0 [⇒] throw e' # es, s1"

― ‹ init rules ›

| InitFinal1:
  "P 1 e,s  e',s'  P 1 INIT C (Nil,b)  e,s  e',s'"
| InitNone1:
  " sh C = None; P 1 INIT C' (C#Cs,False)  e,(h,l,sh(C  (sblank P C, Prepared)))  e',s' 
   P 1 INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"
| InitDone1:
  " sh C = Some(sfs,Done); P 1 INIT C' (Cs,True)  e,(h,l,sh)  e',s' 
   P 1 INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"
| InitProcessing1:
  " sh C = Some(sfs,Processing); P 1 INIT C' (Cs,True)  e,(h,l,sh)  e',s' 
   P 1 INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"
| InitError1:
  " sh C = Some(sfs,Error);
     P 1 RI (C, THROW NoClassDefFoundError);Cs  e,(h,l,sh)  e',s' 
   P 1 INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"
| InitObject1:
  " sh C = Some(sfs,Prepared);
     C = Object;
     sh' = sh(C  (sfs,Processing));
     P 1 INIT C' (C#Cs,True)  e,(h,l,sh')  e',s' 
   P 1 INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"
| InitNonObject1:
  " sh C = Some(sfs,Prepared);
     C  Object;
     class P C = Some (D,r);
     sh' = sh(C  (sfs,Processing));
     P 1 INIT C' (D#C#Cs,False)  e,(h,l,sh')  e',s' 
   P 1 INIT C' (C#Cs,False)  e,(h,l,sh)  e',s'"
| InitRInit1:
  "P 1 RI (C,Csclinit([]));Cs  e,(h,l,sh)  e',s'
   P 1 INIT C' (C#Cs,True)  e,(h,l,sh)  e',s'"

| RInit1:
  " P 1 e,s  Val v, (h',l',sh');
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Done));
     C' = last(C#Cs);
     P 1 INIT C' (Cs,True)  e', (h',l',sh'')  e1,s1 
   P 1 RI (C,e);Cs  e',s  e1,s1"
| RInitInitFail1:
  " P 1 e,s  throw a, (h',l',sh');
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Error));
     P 1 RI (D,throw a);Cs  e', (h',l',sh'')  e1,s1 
   P 1 RI (C,e);D#Cs  e',s  e1,s1"
| RInitFailFinal1:
  " P 1 e,s  throw a, (h',l',sh');
     sh' C = Some(sfs, i); sh'' = sh'(C  (sfs, Error)) 
   P 1 RI (C,e);Nil  e',s  throw a, (h',l',sh'')"


(*<*)
lemmas eval1_evals1_induct = eval1_evals1.induct [split_format (complete)]
  and eval1_evals1_inducts = eval1_evals1.inducts [split_format (complete)]
(*>*)


inductive_cases eval1_cases [cases set]:
 "P 1 new C,s  e',s'"
 "P 1 Cast C e,s  e',s'"
 "P 1 Val v,s  e',s'"
 "P 1 e1 «bop» e2,s  e',s'"
 "P 1 Var v,s  e',s'"
 "P 1 V:=e,s  e',s'"
 "P 1 eF{D},s  e',s'"
 "P 1 CsF{D},s  e',s'"
 "P 1 e1F{D}:=e2,s  e',s'"
 "P 1 CsF{D}:=e2,s  e',s'"
 "P 1 eM(es),s  e',s'"
 "P 1 CsM(es),s  e',s'"
 "P 1 {V:T;e1},s  e',s'"
 "P 1 e1;;e2,s  e',s'"
 "P 1 if (e) e1 else e2,s  e',s'"
 "P 1 while (b) c,s  e',s'"
 "P 1 throw e,s  e',s'"
 "P 1 try e1 catch(C V) e2,s  e',s'"
 "P 1 INIT C (Cs,b)  e,s  e',s'"
 "P 1 RI (C,e);Cs  e0,s  e',s'"
 
inductive_cases evals1_cases [cases set]:
 "P 1 [],s [⇒] e',s'"
 "P 1 e#es,s [⇒] e',s'"
(*>*) 


lemma eval1_final: "P 1 e,s  e',s'  final e'"
 and evals1_final: "P 1 es,s [⇒] es',s'  finals es'"
(*<*)by(induct rule:eval1_evals1.inducts, simp_all)(*>*)


lemma eval1_final_same: " P 1 e,s  e',s'; final e   e = e'  s = s'"
(*<*)
apply(erule finalE)
 using eval1_cases(3) apply blast
by (metis eval1_cases(3,17) exp.distinct(101) exp.inject(3) val.distinct(13))
(*>*)

subsection "Property preservation"

lemma eval1_preserves_len:
  "P 1 e0,(h0,ls0,sh0)  e1,(h1,ls1,sh1)  length ls0 = length ls1"
and evals1_preserves_len:
  "P 1 es0,(h0,ls0,sh0) [⇒] es1,(h1,ls1,sh1)  length ls0 = length ls1"
(*<*)by (induct rule:eval1_evals1_inducts, simp_all)(*>*)


lemma evals1_preserves_elen:
  "es' s s'. P 1 es,s [⇒] es',s'  length es = length es'"
(*<*)
apply(induct es type:list)
apply (auto elim:evals1.cases)
done
(*>*)


lemma clinit1_loc_pres:
 "P 1 C0sclinit([]),(h,l,sh)  e',(h',l',sh')  l = l'"
 by(auto elim!: eval1_cases(12) evals1_cases(1))

lemma
shows init1_ri1_same_loc: "P 1 e,(h,l,sh)  e',(h',l',sh')
    (C Cs b M a. e = INIT C (Cs,b)  unit  e = CsM([])  e = RI (C,Throw a) ; Cs  unit
           e = RI (C,Csclinit([])) ; Cs  unit
            l = l')"
  and "P 1 es,(h,l,sh) [⇒] es',(h',l',sh')  True"
proof(induct rule: eval1_evals1_inducts)
  case (RInitInitFail1 e h l sh a')
  then show ?case using eval1_final[of _ _ _ "throw a'"]
     by(fastforce dest: eval1_final_same[of _ "Throw a"])
next
  case RInitFailFinal1 then show ?case by(auto dest: eval1_final_same)
qed(auto dest: evals1_cases eval1_cases(17) eval1_final_same)

lemma init1_same_loc: "P 1 INIT C (Cs,b)  unit,(h,l,sh)  e',(h',l',sh')  l = l'"
 by(simp add: init1_ri1_same_loc)


theorem eval1_hext: "P 1 e,(h,l,sh)  e',(h',l',sh')  h  h'"
and evals1_hext:  "P 1 es,(h,l,sh) [⇒] es',(h',l',sh')  h  h'"
(*<*)
proof (induct rule: eval1_evals1_inducts)
  case New1 thus ?case
    by(fastforce intro!: hext_new intro:LeastI simp:new_Addr_def
                split:if_split_asm simp del:fun_upd_apply)
next
  case NewInit1 thus ?case
    by (meson hext_new hext_trans new_Addr_SomeD)
next
  case FAss1 thus ?case
    by(auto simp:sym[THEN hext_upd_obj] simp del:fun_upd_apply
            elim!: hext_trans)
qed (auto elim!: hext_trans)
(*>*)

subsection "Initialization"

lemma rinit1_throw:
 "P1 1 RI (D,Throw xa) ; Cs  e,(h, l, sh)  e',(h', l', sh')
     e' = Throw xa"
apply(induct Cs arbitrary: D h l sh h' l' sh')
 apply(drule eval1_cases(20), auto elim: eval1_cases)
apply(drule eval1_cases(20), auto elim: eval1_cases dest: eval1_final_same simp: final_def)
done

lemma rinit1_throwE:
"P 1 RI (C,throw e) ; Cs  e0,s  e',s'
    a st. e' = throw a  P 1 throw e,s  throw a,st"
proof(induct Cs arbitrary: C e s)
  case Nil
  then show ?case
  proof(rule eval1_cases(20)) ― ‹ RI ›
    fix v h' l' sh' assume "P 1 throw e,s  Val v,(h', l', sh')"
    then show ?case using eval1_cases(17) by blast
  qed(auto)
next
  case (Cons C' Cs')
  show ?case using Cons.prems(1)
  proof(rule eval1_cases(20)) ― ‹ RI ›
    fix v h' l' sh' assume "P 1 throw e,s  Val v,(h', l', sh')"
    then show ?case using eval1_cases(17) by blast
  next
    fix a h' l' sh' sfs i D Cs''
    assume e''step: "P 1 throw e,s  throw a,(h', l', sh')"
       and shC: "sh' C = (sfs, i)"
       and riD: "P 1 RI (D,throw a) ; Cs''  e0,(h', l', sh'(C  (sfs, Error)))  e',s'"
       and "C' # Cs' = D # Cs''"
    then show ?thesis using Cons.hyps eval1_final eval1_final_same by blast
  qed(simp)
qed

end

Theory J1WellForm

(*  Title:      JinjaDCI/Compiler/J1WellForm.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Compiler/J1WellForm.thy by Tobias Nipkow
*)

section ‹ Well-Formedness of Intermediate Language ›

theory J1WellForm
imports "../J/JWellForm" J1
begin

subsection "Well-Typedness"

type_synonym 
  env1  = "ty list"   ― ‹type environment indexed by variable number›

inductive
  WT1 :: "[J1_prog,env1, expr1     , ty     ]  bool"
         ("(_,_ 1/ _ :: _)"   [51,51,51]50)
  and WTs1 :: "[J1_prog,env1, expr1 list, ty list]  bool"
         ("(_,_ 1/ _ [::] _)" [51,51,51]50)
  for P :: J1_prog
where
  
  WTNew1:
  "is_class P C  
  P,E 1 new C :: Class C"

| WTCast1:
  " P,E 1 e :: Class D;  is_class P C;  P  C * D  P  D * C 
   P,E 1 Cast C e :: Class C"

| WTVal1:
  "typeof v = Some T 
  P,E 1 Val v :: T"

| WTVar1:
  " E!i = T; i < size E 
   P,E 1 Var i :: T"

| WTBinOp1:
  " P,E 1 e1 :: T1;  P,E 1 e2 :: T2;
     case bop of Eq  (P  T1  T2  P  T2  T1)  T = Boolean
               | Add  T1 = Integer  T2 = Integer  T = Integer 
   P,E 1 e1 «bop» e2 :: T"

| WTLAss1:
  " E!i = T;  i < size E; P,E 1 e :: T';  P  T'  T 
   P,E 1 i:=e :: Void"

| WTFAcc1:
  " P,E 1 e :: Class C;  P  C sees F,NonStatic:T in D 
   P,E 1 eF{D} :: T"

| WTSFAcc1:
  " P  C sees F,Static:T in D 
   P,E 1 CsF{D} :: T"

| WTFAss1:
  " P,E 1 e1 :: Class C;  P  C sees F,NonStatic:T in D;  P,E 1 e2 :: T';  P  T'  T 
   P,E 1 e1F{D} := e2 :: Void"

| WTSFAss1:
  "  P  C sees F,Static:T in D;  P,E 1 e2 :: T';  P  T'  T 
   P,E 1 CsF{D}:=e2 :: Void"

| WTCall1:
  " P,E 1 e :: Class C; P  C sees M,NonStatic:Ts'  T = m in D;
    P,E 1 es [::] Ts;  P  Ts [≤] Ts' 
   P,E 1 eM(es) :: T"

| WTSCall1:
  " P  C sees M,Static:Ts  T = m in D;
     P,E 1 es [::] Ts';  P  Ts' [≤] Ts; M  clinit 
   P,E 1 CsM(es) :: T"

| WTBlock1:
  " is_type P T; P,E@[T] 1 e::T' 
    P,E 1 {i:T; e} :: T'"

| WTSeq1:
  " P,E 1 e1::T1;  P,E 1 e2::T2 
    P,E 1 e1;;e2 :: T2"

| WTCond1:
  " P,E 1 e :: Boolean;  P,E 1 e1::T1;  P,E 1 e2::T2;
    P  T1  T2  P  T2  T1;  P  T1  T2  T = T2; P  T2  T1  T = T1 
   P,E 1 if (e) e1 else e2 :: T"

| WTWhile1:
  " P,E 1 e :: Boolean;  P,E 1 c::T 
   P,E 1 while (e) c :: Void"

| WTThrow1:
  "P,E 1 e :: Class C  
  P,E 1 throw e :: Void"

| WTTry1:
  " P,E 1 e1 :: T;  P,E@[Class C] 1 e2 :: T; is_class P C 
   P,E 1 try e1 catch(C i) e2 :: T"

| WTNil1:
  "P,E 1 [] [::] []"

| WTCons1:
  " P,E 1 e :: T; P,E 1 es [::] Ts 
    P,E 1 e#es [::] T#Ts"

(*<*)
declare  WT1_WTs1.intros[intro!]
declare WTNil1[iff]

lemmas WT1_WTs1_induct = WT1_WTs1.induct [split_format (complete)]
  and WT1_WTs1_inducts = WT1_WTs1.inducts [split_format (complete)]

inductive_cases eee[elim!]:
  "P,E 1 Val v :: T"
  "P,E 1 Var i :: T"
  "P,E 1 Cast D e :: T"
  "P,E 1 i:=e :: T"
  "P,E 1 {i:U; e} :: T"
  "P,E 1 e1;;e2 :: T"
  "P,E 1 if (e) e1 else e2 :: T"
  "P,E 1 while (e) c :: T"
  "P,E 1 throw e :: T"
  "P,E 1 try e1 catch(C i) e2 :: T"
  "P,E 1 eF{D} :: T"
  "P,E 1 CsF{D} :: T"
  "P,E 1 e1F{D}:=e2 :: T"
  "P,E 1 CsF{D}:=e2 :: T"
  "P,E 1 e1 «bop» e2 :: T"
  "P,E 1 new C :: T"
  "P,E 1 eM(es) :: T"
  "P,E 1 CsM(es) :: T"
  "P,E 1 [] [::] Ts"
  "P,E 1 e#es [::] Ts"
(*>*)

lemma init_nWT1 [simp]:"¬P,E 1 INIT C (Cs,b)  e :: T"
 by(auto elim:WT1.cases)
lemma rinit_nWT1 [simp]:"¬P,E 1 RI(C,e);Cs  e' :: T"
 by(auto elim:WT1.cases)

lemma WTs1_same_size: "Ts. P,E 1 es [::] Ts  size es = size Ts"
(*<*)by (induct es type:list) auto(*>*)


lemma WT1_unique:
  "P,E 1 e :: T1  (T2. P,E 1 e :: T2  T1 = T2)" and
  WTs1_unique: "P,E 1 es [::] Ts1  (Ts2. P,E 1 es [::] Ts2  Ts1 = Ts2)"
(*<*)
apply(induct rule:WT1_WTs1.inducts)
apply blast
apply blast
apply clarsimp
apply blast
apply clarsimp
apply(case_tac bop)
apply clarsimp
apply clarsimp
apply blast
apply (blast dest:sees_field_idemp sees_field_fun)
apply (blast dest:sees_field_fun)
apply blast
apply (blast dest:sees_field_fun)
apply (blast dest:sees_method_idemp sees_method_fun)
apply (blast dest:sees_method_fun)
apply blast
apply blast
apply blast
apply blast
apply clarify
apply blast
apply blast
apply blast
done
(*>*)


lemma assumes wf: "wf_prog p P"
shows WT1_is_type: "P,E 1 e :: T  set E  types P  is_type P T"
and "P,E 1 es [::] Ts  True"
(*<*)
apply(induct rule:WT1_WTs1.inducts)
apply simp
apply simp
apply (simp add:typeof_lit_is_type)
apply (blast intro:nth_mem)
apply(simp split:bop.splits)
apply simp
apply (simp add:sees_field_is_type[OF _ wf])
apply (simp add:sees_field_is_type[OF _ wf])
apply simp
apply simp
apply(fastforce dest!: sees_wf_mdecl[OF wf] simp:wf_mdecl_def)
apply(fastforce dest!: sees_wf_mdecl[OF wf] simp:wf_mdecl_def)
apply simp
apply simp
apply blast
apply simp
apply simp
apply simp
apply simp
apply simp
done
(*>*)

lemma WT1_nsub_RI: "P,E 1 e :: T  ¬sub_RI e"
 and WTs1_nsub_RIs: "P,E 1 es [::] Ts  ¬sub_RIs es"
proof(induct rule: WT1_WTs1.inducts) qed(simp_all)

subsection‹ Runtime Well-Typedness ›

inductive
  WTrt1 :: "J1_prog  heap  sheap  env1  expr1  ty  bool"
  and WTrts1 :: "J1_prog  heap  sheap  env1  expr1 list  ty list  bool"
  and WTrt21 :: "[J1_prog,env1,heap,sheap,expr1,ty]  bool"
        ("_,_,_,_ 1 _ : _"   [51,51,51,51]50)
  and WTrts21 :: "[J1_prog,env1,heap,sheap,expr1 list, ty list]  bool"
        ("_,_,_,_ 1 _ [:] _" [51,51,51,51]50)
  for P :: J1_prog and h :: heap and sh :: sheap
where
  
  "P,E,h,sh 1 e : T  WTrt1 P h sh E e T"
| "P,E,h,sh 1 es[:]Ts  WTrts1 P h sh E es Ts"

| WTrtNew1:
  "is_class P C  
  P,E,h,sh 1 new C : Class C"

| WTrtCast1:
  " P,E,h,sh 1 e : T; is_refT T; is_class P C 
   P,E,h,sh 1 Cast C e : Class C"

| WTrtVal1:
  "typeofh v = Some T 
  P,E,h,sh 1 Val v : T"

| WTrtVar1:
  " E!i = T; i < size E   
  P,E,h,sh 1 Var i : T"

| WTrtBinOpEq1:
  " P,E,h,sh 1 e1 : T1;  P,E,h,sh 1 e2 : T2 
   P,E,h,sh 1 e1 «Eq» e2 : Boolean"

| WTrtBinOpAdd1:
  " P,E,h,sh 1 e1 : Integer;  P,E,h,sh 1 e2 : Integer 
   P,E,h,sh 1 e1 «Add» e2 : Integer"

| WTrtLAss1:
  " E!i = T; i < size E; P,E,h,sh 1 e : T';  P  T'  T 
    P,E,h,sh 1 i:=e : Void"

| WTrtFAcc1:
  " P,E,h,sh 1 e : Class C; P  C has F,NonStatic:T in D  
  P,E,h,sh 1 eF{D} : T"

| WTrtFAccNT1:
  "P,E,h,sh 1 e : NT 
  P,E,h,sh 1 eF{D} : T"

| WTrtSFAcc1:
  " P  C has F,Static:T in D  
  P,E,h,sh 1 CsF{D} : T"

| WTrtFAss1:
  " P,E,h,sh 1 e1 : Class C;  P  C has F,NonStatic:T in D; P,E,h,sh 1 e2 : T2;  P  T2  T 
   P,E,h,sh 1 e1F{D}:=e2 : Void"

| WTrtFAssNT1:
  " P,E,h,sh 1 e1:NT; P,E,h,sh 1 e2 : T2 
   P,E,h,sh 1 e1F{D}:=e2 : Void"

| WTrtSFAss1:
  " P,E,h,sh 1 e2 : T2; P  C has F,Static:T in D; P  T2  T 
   P,E,h,sh 1 CsF{D}:=e2 : Void"

| WTrtCall1:
  " P,E,h,sh 1 e : Class C; P  C sees M,NonStatic:Ts  T = m in D;
     P,E,h,sh 1 es [:] Ts'; P  Ts' [≤] Ts 
   P,E,h,sh 1 eM(es) : T"

| WTrtCallNT1:
  " P,E,h,sh 1 e : NT; P,E,h,sh 1 es [:] Ts 
   P,E,h,sh 1 eM(es) : T"

| WTrtSCall1:
  " P  C sees M,Static:Ts  T = m in D;
     P,E,h,sh 1 es [:] Ts'; P  Ts' [≤] Ts;
     M = clinit  sh D = (sfs,Processing)  es = map Val vs 
   P,E,h,sh 1 CsM(es) : T"

| WTrtBlock1:
  "P,E@[T],h,sh 1 e : T'  
  P,E,h,sh 1 {i:T; e} : T'"

| WTrtSeq1:
  " P,E,h,sh 1 e1:T1;  P,E,h,sh 1 e2:T2 
   P,E,h,sh 1 e1;;e2 : T2"

| WTrtCond1:
  " P,E,h,sh 1 e : Boolean;  P,E,h,sh 1 e1:T1;  P,E,h,sh 1 e2:T2;
     P  T1  T2  P  T2  T1; P  T1  T2  T = T2; P  T2  T1  T = T1 
   P,E,h,sh 1 if (e) e1 else e2 : T"

| WTrtWhile1:
  " P,E,h,sh 1 e : Boolean;  P,E,h,sh 1 c:T 
    P,E,h,sh 1 while(e) c : Void"

| WTrtThrow1:
  " P,E,h,sh 1 e : Tr; is_refT Tr  
  P,E,h,sh 1 throw e : T"

| WTrtTry1:
  " P,E,h,sh 1 e1 : T1;  P,E@[Class C],h,sh 1 e2 : T2; P  T1  T2 
   P,E,h,sh 1 try e1 catch(C i) e2 : T2"

| WTrtInit1:
  " P,E,h,sh 1 e : T; C'  set (C#Cs). is_class P C'; ¬sub_RI e;
     C'  set (tl Cs). sfs. sh C' = (sfs,Processing);
     b  (C'  set Cs. sfs. sh C' = (sfs,Processing));
     distinct Cs; supercls_lst P Cs 
   P,E,h,sh 1 INIT C (Cs, b)  e : T"

| WTrtRI1:
  " P,E,h,sh 1 e : T; P,E,h,sh 1 e' : T'; C'  set (C#Cs). is_class P C'; ¬sub_RI e';
     C'  set (C#Cs). not_init C' e;
     C'  set Cs. sfs. sh C' = (sfs,Processing);
     sfs. sh C = (sfs, Processing)  (sh C = (sfs, Error)  e = THROW NoClassDefFoundError);
     distinct (C#Cs); supercls_lst P (C#Cs) 
   P,E,h,sh 1 RI(C, e);Cs  e' : T'"

― ‹well-typed expression lists›

| WTrtNil1:
  "P,E,h,sh 1 [] [:] []"

| WTrtCons1:
  " P,E,h,sh 1 e : T;  P,E,h,sh 1 es [:] Ts 
    P,E,h,sh 1 e#es [:] T#Ts"

(*<*)
declare WTrt1_WTrts1.intros[intro!] WTrtNil1[iff]
declare
  WTrtFAcc1[rule del] WTrtFAccNT1[rule del] WTrtSFAcc1[rule del]
  WTrtFAss1[rule del] WTrtFAssNT1[rule del] WTrtSFAss1[rule del]
  WTrtCall1[rule del] WTrtCallNT1[rule del] WTrtSCall1[rule del]

lemmas WTrt1_induct = WTrt1_WTrts1.induct [split_format (complete)]
  and WTrt1_inducts = WTrt1_WTrts1.inducts [split_format (complete)]
(*>*)

(*<*)
inductive_cases WTrt1_elim_cases[elim!]:
  "P,E,h,sh 1 Val v : T"
  "P,E,h,sh 1 Var i : T"
  "P,E,h,sh 1 v :=e : T"
  "P,E,h,sh 1 {i:U; e} : T"
  "P,E,h,sh 1 e1;;e2 : T2"
  "P,E,h,sh 1 if (e) e1 else e2 : T"
  "P,E,h,sh 1 while(e) c : T"
  "P,E,h,sh 1 throw e : T"
  "P,E,h,sh 1 try e1 catch(C V) e2 : T"
  "P,E,h,sh 1 Cast D e : T"
  "P,E,h,sh 1 eF{D} : T"
  "P,E,h,sh 1 CsF{D} : T"
  "P,E,h,sh 1 eF{D} := v : T"
  "P,E,h,sh 1 CsF{D} := v : T"
  "P,E,h,sh 1 e1 «bop» e2 : T"
  "P,E,h,sh 1 new C : T"
  "P,E,h,sh 1 eM{D}(es) : T"
  "P,E,h,sh 1 CsM{D}(es) : T"
  "P,E,h,sh 1 INIT C (Cs,b)  e : T"
  "P,E,h,sh 1 RI(C,e);Cs  e' : T"
  "P,E,h,sh 1 [] [:] Ts"
  "P,E,h,sh 1 e#es [:] Ts"
(*>*)

lemma WT1_implies_WTrt1: "P,E 1 e :: T  P,E,h,sh 1 e : T"
and WTs1_implies_WTrts1: "P,E 1 es [::] Ts  P,E,h,sh 1 es [:] Ts"
(*<*)
apply(induct rule: WT1_WTs1_inducts)
apply fast
apply (fast)
apply(fastforce dest:typeof_lit_typeof)
apply(fast)
apply(rename_tac E e1 T1 e2 T2 bop T) apply(case_tac bop)
 apply(fastforce)
 apply(fastforce)
apply(fastforce)
apply(meson WTrtFAcc1 has_visible_field)
apply(meson WTrtSFAcc1 has_visible_field)
apply(meson WTrtFAss1 has_visible_field)
apply(meson WTrtSFAss1 has_visible_field)
apply(fastforce simp: WTrtCall1)
apply(fastforce simp: WTrtSCall1)
apply(fastforce)
apply(fastforce)
apply(fastforce simp: WTrtCond1)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(simp)
apply(fast)
done
(*>*)

subsection‹ Well-formedness›

― ‹Indices in blocks increase by 1›

primrec  :: "expr1  nat  bool"
  and ℬs :: "expr1 list  nat  bool" where
" (new C) i = True" |
" (Cast C e) i =  e i" |
" (Val v) i = True" |
" (e1 «bop» e2) i = ( e1 i   e2 i)" |
" (Var j) i = True" |
" (eF{D}) i =  e i" |
" (CsF{D}) i = True" |
" (j:=e) i =  e i" |
" (e1F{D} := e2) i = ( e1 i   e2 i)" |
" (CsF{D} := e2) i =  e2 i" |
" (eM(es)) i = ( e i  ℬs es i)" |
" (CsM(es)) i = ℬs es i" |
" ({j:T ; e}) i = (i = j   e (i+1))" |
" (e1;;e2) i = ( e1 i   e2 i)" |
" (if (e) e1 else e2) i = ( e i   e1 i   e2 i)" |
" (throw e) i =  e i" |
" (while (e) c) i = ( e i   c i)" |
" (try e1 catch(C j) e2) i = ( e1 i  i=j   e2 (i+1))" |
" (INIT C (Cs,b)  e) i =  e i" |
" (RI(C,e);Cs  e') i = ( e i   e' i)" |

"ℬs [] i = True" |
"ℬs (e#es) i = ( e i  ℬs es i)"


definition wf_J1_mdecl :: "J1_prog  cname  expr1 mdecl  bool"
where
  "wf_J1_mdecl P C    λ(M,b,Ts,T,body).
    ¬sub_RI body 
 (case b of
    NonStatic 
        (T'. P,Class C#Ts 1 body :: T'  P  T'  T) 
        𝒟 body {..size Ts} body (size Ts + 1)
  | Static  (T'. P,Ts 1 body :: T'  P  T'  T) 
        𝒟 body {..<size Ts} body (size Ts))"

lemma wf_J1_mdecl_NonStatic[simp]:
  "wf_J1_mdecl P C (M,NonStatic,Ts,T,body) 
    (¬sub_RI body 
    (T'. P,Class C#Ts 1 body :: T'  P  T'  T) 
     𝒟 body {..size Ts} body (size Ts + 1))"
(*<*)by (simp add:wf_J1_mdecl_def)(*>*)

lemma wf_J1_mdecl_Static[simp]:
  "wf_J1_mdecl P C (M,Static,Ts,T,body) 
    (¬sub_RI body 
    (T'. P,Ts 1 body :: T'  P  T'  T) 
     𝒟 body {..<size Ts} body (size Ts))"
(*<*)by (simp add:wf_J1_mdecl_def)(*>*)

abbreviation "wf_J1_prog == wf_prog wf_J1_mdecl"

lemma sees_wf1_nsub_RI:
 " wf_J1_prog P; P  C sees M,b : TsT = body in D   ¬sub_RI body"
apply(drule sees_wf_mdecl, simp)
apply(unfold wf_J1_mdecl_def wf_mdecl_def, simp)
done

lemma wf1_types_clinit:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a" and proc: "sh C = (sfs, Processing)"
shows "P,E,h,sh 1 Csclinit([]) : Void"
proof -
  from ex obtain D fs ms where "a = (D,fs,ms)" by(cases a)
  then have sP: "(C, D, fs, ms)  set P" using ex map_of_SomeD[of P C a] by(simp add: class_def)
  then have "wf_clinit ms" using assms by(unfold wf_prog_def wf_cdecl_def, auto)
  then obtain m where sm: "(clinit, Static, [], Void, m)  set ms"
    by(unfold wf_clinit_def) auto
  then have "P  C sees clinit,Static:[]  Void = m in C"
    using mdecl_visible[OF wf sP sm] by simp
  then show ?thesis using WTrtSCall1 proc by blast
qed


lemma assumes wf: "wf_J1_prog P"
shows eval1_proc_pres: "P 1 e,(h,l,sh)  e',(h',l',sh')
   not_init C e  sfs. sh C = (sfs, Processing)  sfs'. sh' C = (sfs', Processing)"
  and evals1_proc_pres: "P 1 es,(h,l,sh) [⇒] es',(h',l',sh')
   not_inits C es  sfs. sh C = (sfs, Processing)  sfs'. sh' C = (sfs', Processing)"
(*<*)
proof(induct rule:eval1_evals1_inducts)
  case Call1 then show ?case using sees_wf1_nsub_RI[OF wf Call1.hyps(6)] nsub_RI_not_init by auto
next
  case (SCallInit1 ps h l sh vs h1 l1 sh1 C' M Ts T body D v' h2 l2 sh2 l2' e' h3 l3 sh3)
  then show ?case
    using SCallInit1 sees_wf1_nsub_RI[OF wf SCallInit1.hyps(3)] nsub_RI_not_init[of body] by auto
next
  case SCall1 then show ?case using sees_wf1_nsub_RI[OF wf SCall1.hyps(3)] nsub_RI_not_init by auto
next
  case (InitNone1 sh C1 C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
  case (InitDone1 sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
  case (InitProcessing1 sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
  case (InitError1 sh C1 sfs Cs h l e' a a b C') then show ?case by(cases "C = C1") auto
next
  case (InitObject1 sh C1 sfs sh' C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
  case (InitNonObject1 sh C1 sfs D a b sh' C' Cs h l e' a a b)
  then show ?case by(cases "C = C1") auto
next
  case (RInit1 e a a b v h' l' sh' C sfs i sh'' C' Cs e1 a a b) then show ?case by(cases Cs, auto)
next
  case (RInitInitFail1 e h l sh a h' l' sh' C1 sfs i sh'' D Cs e1 h1 l1 sh1)
  then show ?case using eval1_final by fastforce
qed(auto)

lemma clinit1_proc_pres:
  " wf_J1_prog P; P 1 C0sclinit([]),(h,l,sh)  e',(h',l',sh');
     sh C' = (sfs,Processing) 
   sfs. sh' C' = (sfs,Processing)"
 by(auto dest: eval1_proc_pres)

end

Theory PCompiler

(*  Title:      JinjaDCI/Compiler/PCompiler.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Common/PCompiler.thy by Tobias Nipkow
*)

section ‹ Program Compilation ›

theory PCompiler
imports "../Common/WellForm"
begin

definition compM :: "(staticb  'a  'b)  'a mdecl  'b mdecl"
where
  "compM f    λ(M, b, Ts, T, m). (M, b, Ts, T, f b m)"

definition compC :: "(staticb  'a  'b)  'a cdecl  'b cdecl"
where
  "compC f    λ(C,D,Fdecls,Mdecls). (C,D,Fdecls, map (compM f) Mdecls)"

definition compP :: "(staticb  'a  'b)  'a prog  'b prog"
where
  "compP f    map (compC f)"

text‹ Compilation preserves the program structure.  Therefore lookup
functions either commute with compilation (like method lookup) or are
preserved by it (like the subclass relation). ›

lemma map_of_map4:
  "map_of (map (λ(x,a,b,c).(x,a,b,f c)) ts) =
  map_option (λ(a,b,c).(a,b,f c))  (map_of ts)"
(*<*)
apply(induct ts)
 apply simp
apply(rule ext)
apply fastforce
done
(*>*)

lemma map_of_map245:
  "map_of (map (λ(x,a,b,c,d).(x,a,b,c,f a c d)) ts) =
  map_option (λ(a,b,c,d).(a,b,c,f a c d))  (map_of ts)"
(*<*)
apply(induct ts)
 apply simp
apply(rule ext)
apply fastforce
done
(*>*)


lemma class_compP:
  "class P C = Some (D, fs, ms)
   class (compP f P) C = Some (D, fs, map (compM f) ms)"
(*<*)by(simp add:class_def compP_def compC_def map_of_map4)(*>*)


lemma class_compPD:
  "class (compP f P) C = Some (D, fs, cms)
   ms. class P C = Some(D,fs,ms)  cms = map (compM f) ms"
(*<*)by(clarsimp simp add:class_def compP_def compC_def map_of_map4)(*>*)


lemma [simp]: "is_class (compP f P) C = is_class P C"
(*<*)by(auto simp:is_class_def dest: class_compP class_compPD)(*>*)


lemma [simp]: "class (compP f P) C = map_option (λc. snd(compC f (C,c))) (class P C)"
(*<*)
apply(simp add:compP_def compC_def class_def map_of_map4)
apply(simp add:split_def)
done
(*>*)


lemma sees_methods_compP:
  "P  C sees_methods Mm 
  compP f P  C sees_methods (map_option (λ((b,Ts,T,m),D). ((b,Ts,T,f b m),D))  Mm)"
(*<*)
apply(erule Methods.induct)
 apply(rule sees_methods_Object)
  apply(erule class_compP)
 apply(rule ext)
 apply(simp add:compM_def map_of_map245 option.map_comp)
 apply(case_tac "map_of ms x")
  apply simp
 apply fastforce
apply(rule sees_methods_rec)
   apply(erule class_compP)
  apply assumption
 apply assumption
apply(rule ext)
apply(simp add:map_add_def compM_def map_of_map245 option.map_comp split:option.split)
done
(*>*)


lemma sees_method_compP:
  "P  C sees M,b: TsT = m in D 
  compP f P  C sees M,b: TsT = (f b m) in D"
(*<*)by(fastforce elim:sees_methods_compP simp add:Method_def)(*>*)


lemma [simp]:
  "P  C sees M,b: TsT = m in D 
  method (compP f P) C M = (D,b,Ts,T,f b m)"
(*<*)
apply(drule sees_method_compP)
apply(simp add:method_def)
apply(rule the_equality)
 apply simp
apply(fastforce dest:sees_method_fun)
done
(*>*)


lemma sees_methods_compPD:
  " cP  C sees_methods Mm'; cP = compP f P  
  Mm. P  C sees_methods Mm 
        Mm' = (map_option (λ((b,Ts,T,m),D). ((b,Ts,T,f b m),D))  Mm)"
(*<*)
apply(erule Methods.induct)
 apply(clarsimp simp:compC_def)
 apply(rule exI)
 apply(rule conjI, erule sees_methods_Object)
  apply(rule refl)
 apply(rule ext)
 apply(simp add:compM_def map_of_map245 option.map_comp)
 apply(case_tac "map_of b x")
  apply simp
 apply fastforce
apply(clarsimp simp:compC_def)
apply(rule exI, rule conjI)
 apply(erule (2) sees_methods_rec)
 apply(rule refl)
apply(rule ext)
apply(simp add:map_add_def compM_def map_of_map245 option.map_comp split:option.split)
done
(*>*)


lemma sees_method_compPD:
  "compP f P  C sees M,b: TsT = fm in D 
  m. P  C sees M,b: TsT = m in D  f b m = fm"
(*<*)
apply(simp add:Method_def)
apply clarify
apply(drule sees_methods_compPD[OF _ refl])
apply clarsimp
apply blast
done
(*>*)


lemma [simp]: "subcls1(compP f P) = subcls1 P"
(*<*)
by(fastforce simp add: is_class_def compC_def intro:subcls1I order_antisym dest:subcls1D)
(*>*)


lemma compP_widen[simp]: "(compP f P  T  T') = (P  T  T')"
(*<*)by(cases T')(simp_all add:widen_Class)(*>*)


lemma [simp]: "(compP f P  Ts [≤] Ts') = (P  Ts [≤] Ts')"
(*<*)
apply(induct Ts)
 apply simp
apply(cases Ts')
 apply(auto simp:fun_of_def)
done
(*>*)


lemma [simp]: "is_type (compP f P) T = is_type P T"
(*<*)by(cases T) simp_all(*>*)


lemma [simp]: "(compP (f::staticb'a'b) P  C has_fields FDTs) = (P  C has_fields FDTs)"
(*<*)
 (is "?A = ?B")
proof
  { fix cP::"'b prog" assume "cP  C has_fields FDTs"
    hence "cP = compP f P  P  C has_fields FDTs"
    proof induct
      case has_fields_Object
      thus ?case by(fast intro:Fields.has_fields_Object dest:class_compPD)
    next
      case has_fields_rec
      thus ?case by(fast intro:Fields.has_fields_rec dest:class_compPD)
    qed
  } note lem = this
  assume ?A
  with lem show ?B by blast
next
  assume ?B
  thus ?A
  proof induct
    case has_fields_Object
    thus ?case by(fast intro:Fields.has_fields_Object class_compP)
  next
    case has_fields_rec
    thus ?case by(fast intro:Fields.has_fields_rec class_compP)
  qed
qed
(*>*)


lemma fields_compP [simp]: "fields (compP f P) C = fields P C"
(*<*)by(simp add:fields_def)(*>*)

lemma ifields_compP [simp]: "ifields (compP f P) C = ifields P C"
(*<*)by(simp add:ifields_def)(*>*)

lemma blank_compP [simp]: "blank (compP f P) C = blank P C"
(*<*)by(simp add:blank_def)(*>*)

lemma isfields_compP [simp]: "isfields (compP f P) C = isfields P C"
(*<*)by(simp add:isfields_def)(*>*)

lemma sblank_compP [simp]: "sblank (compP f P) C = sblank P C"
(*<*)by(simp add:sblank_def)(*>*)

lemma sees_fields_compP [simp]: "(compP f P  C sees F,b:T in D) = (P  C sees F,b:T in D)"
(*<*)by(simp add:sees_field_def)(*>*)

lemma has_field_compP [simp]: "(compP f P  C has F,b:T in D) = (P  C has F,b:T in D)"
(*<*)by(simp add:has_field_def)(*>*)

lemma field_compP [simp]: "field (compP f P) F D = field P F D"
(*<*)by(simp add:field_def)(*>*)


subsection‹Invariance of @{term wf_prog} under compilation ›

lemma [iff]: "distinct_fst (compP f P) = distinct_fst P"
(*<*)
apply(simp add:distinct_fst_def compP_def compC_def)
apply(induct P)
apply (auto simp:image_iff)
done
(*>*)


lemma [iff]: "distinct_fst (map (compM f) ms) = distinct_fst ms"
(*<*)
apply(simp add:distinct_fst_def compM_def)
apply(induct ms)
apply (auto simp:image_iff)
done
(*>*)


lemma [iff]: "wf_syscls (compP f P) = wf_syscls P"
(*<*)by(simp add:wf_syscls_def compP_def compC_def image_def Bex_def)(*>*)


lemma [iff]: "wf_fdecl (compP f P) = wf_fdecl P"
(*<*)by(simp add:wf_fdecl_def)(*>*)


lemma wf_clinit_compM [iff]: "wf_clinit (map (compM f) ms) = wf_clinit ms"
(*<*)
apply(simp add: wf_clinit_def compM_def)
apply(rule iffI)
 apply clarsimp apply(rename_tac m)
 apply(rule_tac x = m in exI, simp+)
apply clarsimp apply(rename_tac m)
apply(rule_tac x = "f Static m" in exI, simp add: rev_image_eqI)
done
(*>*)

lemma set_compP:
 "((C,D,fs,ms')  set(compP f P)) =
  (ms. (C,D,fs,ms)  set P  ms' = map (compM f) ms)"
(*<*)by(fastforce simp add:compP_def compC_def image_iff Bex_def)(*>*)

lemma wf_cdecl_compPI:
  " C M b Ts T m. 
      wf_mdecl wf1 P C (M,b,Ts,T,m); P  C sees M,b:TsT = m in C 
      wf_mdecl wf2 (compP f P) C (M,b,Ts,T, f b m);
    xset P. wf_cdecl wf1 P x; x  set (compP f P); wf_prog p P 
   wf_cdecl wf2 (compP f P) x"
(*<*)
apply(clarsimp simp add:wf_cdecl_def Ball_def set_compP)
apply(rename_tac C D fs ms)
apply(rule conjI)
 apply (clarsimp simp:compM_def)
 apply (drule (2) mdecl_visible)
 apply simp
apply(clarify)
apply(drule sees_method_compPD[where f = f])
apply clarsimp
apply(fastforce simp:image_iff compM_def)
done
(*>*)


lemma wf_prog_compPI:
assumes lift: 
  "C M b Ts T m. 
     P  C sees M,b:TsT = m in C; wf_mdecl wf1 P C (M,b,Ts,T,m) 
     wf_mdecl wf2 (compP f P) C (M,b,Ts,T, f b m)"
and wf: "wf_prog wf1 P"
shows "wf_prog wf2 (compP f P)"
(*<*)
using wf
by (simp add:wf_prog_def) (blast intro:wf_cdecl_compPI lift wf)
(*>*)


end

Theory Hidden

theory Hidden
imports "List-Index.List_Index"
begin

definition hidden :: "'a list  nat  bool" where
"hidden xs i    i < size xs  xs!i  set(drop (i+1) xs)"


lemma hidden_last_index: "x  set xs  hidden (xs @ [x]) (last_index xs x)"
apply(auto simp add: hidden_def nth_append rev_nth[symmetric])
apply(drule last_index_less[OF _ le_refl])
apply simp
done

lemma hidden_inacc: "hidden xs i  last_index xs x  i"
by(auto simp add: hidden_def last_index_drop last_index_less_size_conv)


lemma [simp]: "hidden xs i  hidden (xs@[x]) i"
by(auto simp add:hidden_def nth_append)


lemma fun_upds_apply:
 "(m(xs[↦]ys)) x =
  (let xs' = take (size ys) xs
   in if x  set xs' then Some(ys ! last_index xs' x) else m x)"
apply(induct xs arbitrary: m ys)
 apply (simp add: Let_def)
apply(case_tac ys)
 apply (simp add:Let_def)
apply (simp add: Let_def last_index_Cons)
done


lemma map_upds_apply_eq_Some:
  "((m(xs[↦]ys)) x = Some y) =
  (let xs' = take (size ys) xs
   in if x  set xs' then ys ! last_index xs' x = y else m x = Some y)"
by(simp add:fun_upds_apply Let_def)


lemma map_upds_upd_conv_last_index:
  "x  set xs; size xs  size ys 
   m(xs[↦]ys)(xy) = m(xs[↦]ys[last_index xs x := y])"
apply(rule ext)
apply(simp add:fun_upds_apply eq_sym_conv Let_def)
done

end

Theory Compiler1

(*  Title:      JinjaDCI/Compiler/Compiler1.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Compiler/Compiler1.thy by Tobias Nipkow
*)

section ‹ Compilation Stage 1 ›

theory Compiler1 imports PCompiler J1 Hidden begin

text‹ Replacing variable names by indices. ›

primrec compE1  :: "vname list  expr  expr1"
  and compEs1 :: "vname list  expr list  expr1 list" where
  "compE1 Vs (new C) = new C"
| "compE1 Vs (Cast C e) = Cast C (compE1 Vs e)"
| "compE1 Vs (Val v) = Val v"
| "compE1 Vs (e1 «bop» e2) = (compE1 Vs e1) «bop» (compE1 Vs e2)"
| "compE1 Vs (Var V) = Var(last_index Vs V)"
| "compE1 Vs (V:=e) = (last_index Vs V):= (compE1 Vs e)"
| "compE1 Vs (eF{D}) = (compE1 Vs e)F{D}"
| "compE1 Vs (CsF{D}) = CsF{D}"
| "compE1 Vs (e1F{D}:=e2) = (compE1 Vs e1)F{D} := (compE1 Vs e2)"
| "compE1 Vs (CsF{D}:=e2) = CsF{D} := (compE1 Vs e2)"
| "compE1 Vs (eM(es)) = (compE1 Vs e)M(compEs1 Vs es)"
| "compE1 Vs (CsM(es)) = CsM(compEs1 Vs es)"
| "compE1 Vs {V:T; e} = {(size Vs):T; compE1 (Vs@[V]) e}"
| "compE1 Vs (e1;;e2) = (compE1 Vs e1);;(compE1 Vs e2)"
| "compE1 Vs (if (e) e1 else e2) = if (compE1 Vs e) (compE1 Vs e1) else (compE1 Vs e2)"
| "compE1 Vs (while (e) c) = while (compE1 Vs e) (compE1 Vs c)"
| "compE1 Vs (throw e) = throw (compE1 Vs e)"
| "compE1 Vs (try e1 catch(C V) e2) =
    try(compE1 Vs e1) catch(C (size Vs)) (compE1 (Vs@[V]) e2)"
| "compE1 Vs (INIT C (Cs,b)  e) = INIT C (Cs,b)  (compE1 Vs e)"
| "compE1 Vs (RI(C,e);Cs  e') = RI(C,(compE1 Vs e));Cs  (compE1 Vs e')"

| "compEs1 Vs []     = []"
| "compEs1 Vs (e#es) = compE1 Vs e # compEs1 Vs es"

lemma [simp]: "compEs1 Vs es = map (compE1 Vs) es"
(*<*)by(induct es type:list) simp_all(*>*)

lemma [simp]: "Vs. sub_RI (compE1 Vs e) = sub_RI e"
 and [simp]: "Vs. sub_RIs (compEs1 Vs es) = sub_RIs es"
proof(induct rule: sub_RI_sub_RIs_induct) qed(auto)

primrec fin1:: "expr  expr1" where
  "fin1(Val v) = Val v"
| "fin1(throw e) = throw(fin1 e)"

lemma comp_final: "final e  compE1 Vs e = fin1 e"
(*<*)by(erule finalE, simp_all)(*>*)


lemma [simp]:
      "Vs. max_vars (compE1 Vs e) = max_vars e"
and "Vs. max_varss (compEs1 Vs es) = max_varss es"
(*<*)by (induct e and es rule: max_vars.induct max_varss.induct) simp_all(*>*)


text‹ Compiling programs: ›

definition compP1 :: "J_prog  J1_prog"
where
  "compP1    compP (λb (pns,body). compE1 (case b of NonStatic  this#pns | Static  pns) body)"

(*<*)
declare compP1_def[simp]
(*>*)

end

Theory Correctness1

(*  Title:      JinjaDCI/Compiler/Correctness1.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Compiler/Correctness1.thy by Tobias Nipkow
*)

section ‹ Correctness of Stage 1 ›

theory Correctness1
imports J1WellForm Compiler1
begin

subsection‹Correctness of program compilation ›

primrec unmod :: "expr1  nat  bool"
  and unmods :: "expr1 list  nat  bool" where
"unmod (new C) i = True" |
"unmod (Cast C e) i = unmod e i" |
"unmod (Val v) i = True" |
"unmod (e1 «bop» e2) i = (unmod e1 i  unmod e2 i)" |
"unmod (Var i) j = True" |
"unmod (i:=e) j = (i  j  unmod e j)" |
"unmod (eF{D}) i = unmod e i" |
"unmod (CsF{D}) i = True" |
"unmod (e1F{D}:=e2) i = (unmod e1 i  unmod e2 i)" |
"unmod (CsF{D}:=e2) i = unmod e2 i" |
"unmod (eM(es)) i = (unmod e i  unmods es i)" |
"unmod (CsM(es)) i = unmods es i" |
"unmod {j:T; e} i = unmod e i" |
"unmod (e1;;e2) i = (unmod e1 i   unmod e2 i)" |
"unmod (if (e) e1 else e2) i = (unmod e i  unmod e1 i  unmod e2 i)" |
"unmod (while (e) c) i = (unmod e i  unmod c i)" |
"unmod (throw e) i = unmod e i" |
"unmod (try e1 catch(C i) e2) j = (unmod e1 j  (if i=j then False else unmod e2 j))" |
"unmod (INIT C (Cs,b)  e) i = unmod e i" |
"unmod (RI(C,e);Cs  e') i = (unmod e i  unmod e' i)" |

"unmods ([]) i = True" |
"unmods (e#es) i = (unmod e i  unmods es i)"

lemma hidden_unmod: "Vs. hidden Vs i  unmod (compE1 Vs e) i" and
 "Vs. hidden Vs i  unmods (compEs1 Vs es) i"
(*<*)
apply(induct e and es rule: compE1.induct compEs1.induct)
apply (simp_all add:hidden_inacc)
apply(auto simp add:hidden_def)
done
(*>*)


lemma eval1_preserves_unmod:
  " P 1 e,(h,ls,sh)  e',(h',ls',sh'); unmod e i; i < size ls 
   ls ! i = ls' ! i"
and " P 1 es,(h,ls,sh) [⇒] es',(h',ls',sh'); unmods es i; i < size ls 
       ls ! i = ls' ! i"
(*<*)
proof(induct rule:eval1_evals1_inducts)
  case (RInitInitFail1 e h l sh a h' l' sh' C sfs i sh'' D Cs e1 h1 l1 sh1)
  have "final (throw a)" using eval1_final[OF RInitInitFail1.hyps(1)] by simp
  then show ?case using RInitInitFail1 by(auto simp: eval1_preserves_len)
qed(auto dest!:eval1_preserves_len evals1_preserves_len split:if_split_asm)
(*>*)


lemma LAss_lem:
  "x  set xs; size xs  size ys 
   m1 m m2(xs[↦]ys)  m1(xy) m m2(xs[↦]ys[last_index xs x := y])"
(*<*)
by(simp add:map_le_def fun_upds_apply eq_sym_conv)
(*>*)
lemma Block_lem:
fixes l :: "'a  'b"
assumes 0: "l m [Vs [↦] ls]"
    and 1: "l' m [Vs [↦] ls', Vv]"
    and hidden: "V  set Vs  ls ! last_index Vs V = ls' ! last_index Vs V"
    and size: "size ls = size ls'"    "size Vs < size ls'"
shows "l'(V := l V) m [Vs [↦] ls']"
(*<*)
proof -
  have "l'(V := l V) m [Vs [↦] ls', Vv](V := l V)"
    using 1 by(rule map_le_upd)
  also have " = [Vs [↦] ls'](V := l V)" by simp
  also have " m [Vs [↦] ls']"
  proof (cases "l V")
    case None thus ?thesis by simp
  next
    case (Some w)
    hence "[Vs [↦] ls] V = Some w"
      using 0 by(force simp add: map_le_def split:if_splits)
    hence VinVs: "V  set Vs" and w: "w = ls ! last_index Vs V"
      using size by(auto simp add:fun_upds_apply split:if_splits)
    hence "w = ls' ! last_index Vs V" using hidden[OF VinVs] by simp
    hence "[Vs [↦] ls'](V := l V) = [Vs [↦] ls']" using Some size VinVs
      by(simp add: map_upds_upd_conv_last_index)
    thus ?thesis by simp
  qed
  finally show ?thesis .
qed
(*>*)

(*<*)
declare fun_upd_apply[simp del]
(*>*)


text‹\noindent The main theorem: ›

theorem assumes wf: "wwf_J_prog P"
shows eval1_eval: "P  e,(h,l,sh)  e',(h',l',sh')
   (Vs ls.  fv e  set Vs;  l m [Vs[↦]ls]; size Vs + max_vars e  size ls 
        ls'. compP1 P 1 compE1 Vs e,(h,ls,sh)  fin1 e',(h',ls',sh')  l' m [Vs[↦]ls'])"
(*<*)
  (is "_  (Vs ls. PROP ?P e h l sh e' h' l' sh' Vs ls)"
   is "_  (Vs ls.  _; _; _   ls'. ?Post e h l sh e' h' l' sh' Vs ls ls')")
(*>*)

and evals1_evals: "P  es,(h,l,sh) [⇒] es',(h',l',sh')
     (Vs ls.  fvs es  set Vs;  l m [Vs[↦]ls]; size Vs + max_varss es  size ls 
          ls'. compP1 P 1 compEs1 Vs es,(h,ls,sh) [⇒] compEs1 Vs es',(h',ls',sh') 
                      l' m [Vs[↦]ls'])"
(*<*)
  (is "_  (Vs ls. PROP ?Ps es h l sh es' h' l' sh' Vs ls)"
   is "_  (Vs ls.  _; _; _  ls'. ?Posts es h l sh es' h' l' sh' Vs ls ls')")
proof (induct rule:eval_evals_inducts)
  case Nil thus ?case by(fastforce intro!:Nil1)
next
  case (Cons e h l sh v h' l' sh' es es' h2 l2 sh2)
  have "PROP ?P e h l sh (Val v) h' l' sh' Vs ls" by fact
  with Cons.prems
  obtain ls' where 1: "?Post e h l sh (Val v) h' l' sh' Vs ls ls'"
    "size ls = size ls'" by(auto intro!:eval1_preserves_len)
  have "PROP ?Ps es h' l' sh' es' h2 l2 sh2 Vs ls'" by fact
  with 1 Cons.prems
  obtain ls2 where 2: "?Posts es h' l' sh' es' h2 l2 sh2 Vs ls' ls2" by(auto)
  from 1 2 Cons show ?case by(auto intro!:Cons1)
next
  case ConsThrow thus ?case
    by(fastforce intro!:ConsThrow1 dest: eval_final)
next
  case (Block e h l V sh e' h' l' sh' T)
  let ?Vs = "Vs @ [V]"
  have IH:
  "fv e  set ?Vs; l(V := None) m [?Vs [↦] ls];
    size ?Vs + max_vars e  size ls
    ls'. compP1 P 1 compE1 ?Vs e,(h,ls,sh)  fin1 e',(h', ls',sh') 
             l' m [?Vs [↦] ls']" and
  fv: "fv {V:T; e}  set Vs" and rel: "l m [Vs [↦] ls]" and
  len: "length Vs + max_vars {V:T; e}  length ls" by fact+
  have len': "length Vs < length ls" using len by auto
  have "fv e  set ?Vs" using fv by auto
  moreover have "l(V := None) m [?Vs [↦] ls]" using rel len' by simp
  moreover have "size ?Vs + max_vars e  size ls" using len by simp
  ultimately obtain ls' where
   1: "compP1 P 1 compE1 ?Vs e,(h,ls,sh)  fin1 e',(h',ls',sh')"
   and rel': "l' m [?Vs [↦] ls']" using IH by blast
  have [simp]: "length ls = length ls'" by(rule eval1_preserves_len[OF 1])
  show "ls'. compP1 P 1 compE1 Vs {V:T; e},(h,ls,sh)  fin1 e',(h',ls',sh')
               l'(V := l V) m [Vs [↦] ls']" (is "ls'. ?R ls'")
  proof
    show "?R ls'"
    proof
      show "compP1 P 1 compE1 Vs {V:T; e},(h,ls,sh)  fin1 e',(h',ls',sh')"
        using 1 by(simp add:Block1)
    next
      show "l'(V := l V) m [Vs [↦] ls']"
      proof -
        have "l' m [Vs [↦] ls', V  ls' ! length Vs]"
          using len' rel' by simp
        moreover
        { assume VinVs: "V  set Vs"
          hence "hidden (Vs @ [V]) (last_index Vs V)"
            by(rule hidden_last_index)
          hence "unmod (compE1 (Vs @ [V]) e) (last_index Vs V)"
            by(rule hidden_unmod)
          moreover have "last_index Vs V < length ls"
            using len' VinVs by simp
          ultimately have "ls ! last_index Vs V = ls' ! last_index Vs V"
            by(rule eval1_preserves_unmod[OF 1])
        }
        ultimately show ?thesis using Block_lem[OF rel] len' by auto
      qed
    qed
  qed
next
  case (TryThrow e' h l sh a h' l' sh' D fs C V e2)
  have "PROP ?P e' h l sh (Throw a) h' l' sh' Vs ls" by fact
  with TryThrow.prems
  obtain ls' where 1: "?Post e' h l sh (Throw a) h' l' sh' Vs ls ls'"  by(auto)
  show ?case using 1 TryThrow.hyps by(auto intro!:eval1_evals1.TryThrow1)
next
  case (TryCatch e1 h l sh a h1 l1 sh1 D fs C e2 V e' h2 l2 sh2)
  let ?e = "try e1 catch(C V) e2"
  have IH1: "fv e1  set Vs; l m [Vs [↦] ls];
              size Vs + max_vars e1  length ls
           ls1. compP1 P 1 compE1 Vs e1,(h,ls,sh) 
                                fin1 (Throw a),(h1,ls1,sh1) 
                    l1 m [Vs [↦] ls1]" and
    fv: "fv ?e  set Vs" and
    rel: "l m [Vs [↦] ls]" and
    len: "length Vs + max_vars ?e  length ls" by fact+
  have "fv e1  set Vs" using fv by auto
  moreover have "length Vs + max_vars e1  length ls" using len by(auto)
  ultimately obtain ls1 where
    1: "compP1 P 1 compE1 Vs e1,(h,ls,sh)  Throw a,(h1,ls1,sh1)"
    and rel1: "l1 m [Vs [↦] ls1]" using IH1 rel by fastforce
  from 1 have [simp]: "size ls = size ls1" by(rule eval1_preserves_len)
  let ?Vs = "Vs @ [V]" let ?ls = "(ls1[size Vs:=Addr a])"
  have IH2: "fv e2  set ?Vs; l1(V  Addr a) m [?Vs [↦] ?ls];
              length ?Vs + max_vars e2  length ?ls  ls2.
       compP1 P 1 compE1 ?Vs e2,(h1,?ls,sh1)  fin1 e',(h2, ls2, sh2) 
       l2 m [?Vs [↦] ls2]" by fact
  have len1: "size Vs < size ls1" using len by(auto)
  have "fv e2  set ?Vs" using fv by auto
  moreover have "l1(V  Addr a) m [?Vs [↦] ?ls]" using rel1 len1 by simp
  moreover have "length ?Vs + max_vars e2  length ?ls" using len by(auto)
  ultimately obtain ls2 where
    2: "compP1 P 1 compE1 ?Vs e2,(h1,?ls,sh1)  fin1 e',(h2, ls2, sh2)"
    and rel2: "l2 m [?Vs [↦] ls2]"  using IH2 by blast
  from 2 have [simp]: "size ls1 = size ls2"
    by(fastforce dest: eval1_preserves_len)
  show "ls2. compP1 P 1 compE1 Vs ?e,(h,ls,sh)  fin1 e',(h2,ls2,sh2) 
              l2(V := l1 V) m [Vs [↦] ls2]"  (is "ls2. ?R ls2")
  proof
    show "?R ls2"
    proof
      have hp: "h1 a = Some (D, fs)" by fact
      have "P  D * C" by fact hence caught: "compP1 P  D * C" by simp
      from TryCatch1[OF 1 _ caught len1 2, OF hp]
      show "compP1 P 1 compE1 Vs ?e,(h,ls,sh)  fin1 e',(h2,ls2,sh2)" by simp
    next
      show "l2(V := l1 V) m [Vs [↦] ls2]"
      proof -
        have "l2 m [Vs [↦] ls2, V  ls2 ! length Vs]"
          using len1 rel2 by simp
        moreover
        { assume VinVs: "V  set Vs"
          hence "hidden (Vs @ [V]) (last_index Vs V)" by(rule hidden_last_index)
          hence "unmod (compE1 (Vs @ [V]) e2) (last_index Vs V)"
            by(rule hidden_unmod)
          moreover have "last_index Vs V < length ?ls"
            using len1 VinVs by simp
          ultimately have "?ls ! last_index Vs V = ls2 ! last_index Vs V"
            by(rule eval1_preserves_unmod[OF 2])
          moreover have "last_index Vs V < size Vs" using VinVs by simp
          ultimately have "ls1 ! last_index Vs V = ls2 ! last_index Vs V"
            using len1 by(simp del:size_last_index_conv)
        }
        ultimately show ?thesis using Block_lem[OF rel1] len1  by simp
      qed
    qed
  qed
next
  case Try thus ?case by(fastforce intro!:Try1)
next
  case Throw thus ?case by(fastforce intro!:Throw1)
next
  case ThrowNull thus ?case by(fastforce intro!:ThrowNull1)
next
  case ThrowThrow thus ?case  by(fastforce intro!:ThrowThrow1)
next
  case (CondT e h l sh h1 l1 sh1 e1 e' h2 l2 sh2 e2)
  have "PROP ?P e h l sh true h1 l1 sh1 Vs ls" by fact
  with CondT.prems
  obtain ls1 where 1: "?Post e h l sh true h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"  by(auto intro!:eval1_preserves_len)
  have "PROP ?P e1 h1 l1 sh1 e' h2 l2 sh2 Vs ls1" by fact
  with 1 CondT.prems
  obtain ls2 where 2: "?Post e1 h1 l1 sh1 e' h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 show ?case by(auto intro!:CondT1)
next
  case (CondF e h l sh h1 l1 sh1 e2 e' h2 l2 sh2 e1 Vs ls)
  have "PROP ?P e h l sh false h1 l1 sh1 Vs ls" by fact
  with CondF.prems
  obtain ls1 where 1: "?Post e h l sh false h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"  by(auto intro!:eval1_preserves_len)
  have "PROP ?P e2 h1 l1 sh1 e' h2 l2 sh2 Vs ls1" by fact
  with 1 CondF.prems
  obtain ls2 where 2: "?Post e2 h1 l1 sh1 e' h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 show ?case by(auto intro!:CondF1)
next
  case CondThrow thus ?case by(fastforce intro!:CondThrow1)
next
  case (Seq e h l sh v h1 l1 sh1 e1 e' h2 l2 sh2)
  have "PROP ?P e h l sh (Val v) h1 l1 sh1 Vs ls" by fact
  with Seq.prems
  obtain ls1 where 1: "?Post e h l sh (Val v) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"  by(auto intro!:eval1_preserves_len)
  have "PROP ?P e1 h1 l1 sh1 e' h2 l2 sh2 Vs ls1" by fact
  with 1 Seq.prems
  obtain ls2 where 2: "?Post e1 h1 l1 sh1 e' h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 Seq show ?case by(auto intro!:Seq1)
next
  case SeqThrow thus ?case by(fastforce intro!:SeqThrow1)
next
  case WhileF thus ?case by(fastforce intro!:eval1_evals1.intros)
next
  case (WhileT e h l sh h1 l1 sh1 c v h2 l2 sh2 e' h3 l3 sh3)
  have "PROP ?P e h l sh true h1 l1 sh1 Vs ls" by fact
  with WhileT.prems
  obtain ls1 where 1: "?Post e h l sh true h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"   by(auto intro!:eval1_preserves_len)
  have "PROP ?P c h1 l1 sh1 (Val v) h2 l2 sh2 Vs ls1" by fact
  with 1 WhileT.prems
  obtain ls2 where 2: "?Post c h1 l1 sh1 (Val v) h2 l2 sh2 Vs ls1 ls2"
    "size ls1 = size ls2"    by(auto intro!:eval1_preserves_len)
  have "PROP ?P (While (e) c) h2 l2 sh2 e' h3 l3 sh3 Vs ls2" by fact
  with 1 2 WhileT.prems
  obtain ls3 where 3: "?Post (While (e) c) h2 l2 sh2 e' h3 l3 sh3 Vs ls2 ls3" by(auto)
  from 1 2 3 show ?case by(auto intro!:WhileT1)
next
  case (WhileBodyThrow e h l sh h1 l1 sh1 c e' h2 l2 sh2)
  have "PROP ?P e h l sh true h1 l1 sh1 Vs ls" by fact
  with WhileBodyThrow.prems
  obtain ls1 where 1: "?Post e h l sh true h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?P c h1 l1 sh1 (throw e') h2 l2 sh2 Vs ls1" by fact
  with 1 WhileBodyThrow.prems
  obtain ls2 where 2: "?Post c h1 l1 sh1 (throw e') h2 l2 sh2 Vs ls1 ls2" by auto
  from 1 2 show ?case by(auto intro!:WhileBodyThrow1)
next
  case WhileCondThrow thus ?case by(fastforce intro!:WhileCondThrow1)
next
  case New thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case NewFail thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case NewInit then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case NewInitOOM then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case NewInitThrow then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case Cast thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case CastNull thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case CastThrow thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case (CastFail e h l sh a h1 l1 sh1 D fs C)
  have "PROP ?P e h l sh (addr a) h1 l1 sh1 Vs ls" by fact
  with CastFail.prems
  obtain ls1 where 1: "?Post e h l sh (addr a) h1 l1 sh1 Vs ls ls1" by auto
  show ?case using 1 CastFail.hyps
    by(auto intro!:CastFail1[where D=D])
next
  case Val thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case (BinOp e h l sh v1 h1 l1 sh1 e1 v2 h2 l2 sh2 bop v)
  have "PROP ?P e h l sh (Val v1) h1 l1 sh1 Vs ls" by fact
  with BinOp.prems
  obtain ls1 where 1: "?Post e h l sh (Val v1) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?P e1 h1 l1 sh1 (Val v2) h2 l2 sh2 Vs ls1" by fact
  with 1 BinOp.prems
  obtain ls2 where 2: "?Post e1 h1 l1 sh1 (Val v2) h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 BinOp show ?case by(auto intro!:BinOp1)
next
  case (BinOpThrow2 e0 h l sh v1 h1 l1 sh1 e1 e h2 l2 sh2 bop)
  have "PROP ?P e0 h l sh (Val v1) h1 l1 sh1 Vs ls" by fact
  with BinOpThrow2.prems
  obtain ls1 where 1: "?Post e0 h l sh (Val v1) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?P e1 h1 l1 sh1 (throw e) h2 l2 sh2 Vs ls1" by fact
  with 1 BinOpThrow2.prems
  obtain ls2 where 2: "?Post e1 h1 l1 sh1 (throw e) h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 BinOpThrow2 show ?case by(auto intro!:BinOpThrow21)
next
  case BinOpThrow1 thus ?case  by(fastforce intro!:eval1_evals1.intros)
next
  case Var thus ?case
    by(force intro!:Var1 simp add: map_le_def fun_upds_apply)
next
  case LAss thus ?case
    by(fastforce simp add: LAss_lem intro:eval1_evals1.intros
                dest:eval1_preserves_len)
next
  case LAssThrow thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case FAcc thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case FAccNull thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case FAccThrow thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case (FAccNone e h l sh a h' l' sh' C fs F D)
  have "PROP ?P e h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAccNone.prems
  obtain ls2 where 2: "?Post e h l sh (addr a) h' l' sh' Vs ls ls2" by(auto)
  from 2 FAccNone show ?case by(rule_tac x = ls2 in exI, auto elim!: FAccNone1)
next
  case (FAccStatic e h l sh a h' l' sh' C fs F t D)
  have "PROP ?P e h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAccStatic.prems
  obtain ls2 where 2: "?Post e h l sh (addr a) h' l' sh' Vs ls ls2" by(auto)
  from 2 FAccStatic show ?case by(rule_tac x = ls2 in exI, auto elim!: FAccStatic1)
next
  case SFAcc then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (SFAccInit C F t D sh h l v' h' l' sh' sfs i v)
  have "PROP ?P (INIT D ([D],False)  unit) h l sh (Val v') h' l' sh' Vs ls" by fact
  with SFAccInit.prems
  obtain ls2 where 1: "?Post (INIT D ([D],False)  unit) h l sh (Val v') h' l' sh' Vs ls ls2" by(auto)
  from 1 SFAccInit show ?case by(rule_tac x = ls2 in exI, auto intro: SFAccInit1)
next
  case (SFAccInitThrow C F t D sh h l a h' l' sh')
  have "PROP ?P (INIT D ([D],False)  unit) h l sh (throw a) h' l' sh' Vs ls" by fact
  with SFAccInitThrow.prems
  obtain ls2 where 1: "?Post (INIT D ([D],False)  unit) h l sh (throw a) h' l' sh' Vs ls ls2" by(auto)
  from 1 SFAccInitThrow show ?case by(rule_tac x = ls2 in exI, auto intro: SFAccInitThrow1)
next
  case SFAccNone then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case SFAccNonStatic then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (FAss e1 h l sh a h1 l1 sh1 e2 v h2 l2 sh2 C fs fs' F D h2')
  have "PROP ?P e1 h l sh (addr a) h1 l1 sh1 Vs ls" by fact
  with FAss.prems
  obtain ls1 where 1: "?Post e1 h l sh (addr a) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?P e2 h1 l1 sh1 (Val v) h2 l2 sh2 Vs ls1" by fact
  with 1 FAss.prems
  obtain ls2 where 2: "?Post e2 h1 l1 sh1 (Val v) h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 FAss show ?case by(auto intro!:FAss1)
next
  case (FAssNull e1 h l sh h1 l1 sh1 e2 v h2 l2 sh2 F D)
  have "PROP ?P e1 h l sh null h1 l1 sh1 Vs ls" by fact
  with FAssNull.prems
  obtain ls1 where 1: "?Post e1 h l sh null h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?P e2 h1 l1 sh1 (Val v) h2 l2 sh2 Vs ls1" by fact
  with 1 FAssNull.prems
  obtain ls2 where 2: "?Post e2 h1 l1 sh1 (Val v) h2 l2 sh2 Vs ls1 ls2" by(auto)
  from 1 2 FAssNull show ?case by(auto intro!:FAssNull1)
next
  case FAssThrow1 thus ?case by(fastforce intro:eval1_evals1.intros)
next
  case (FAssThrow2 e1 h l sh v h1 l1 sh1 e2 e h2 l2 sh2 F D)
  have "PROP ?P e1 h l sh (Val v) h1 l1 sh1 Vs ls" by fact
  with FAssThrow2.prems
  obtain ls1 where 1: "?Post e1 h l sh (Val v) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"   by(auto intro!:eval1_preserves_len)
  have "PROP ?P e2 h1 l1 sh1 (throw e) h2 l2 sh2 Vs ls1" by fact
  with 1 FAssThrow2.prems
  obtain ls2 where 2: "?Post e2 h1 l1 sh1 (throw e) h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 FAssThrow2 show ?case by(auto intro!:FAssThrow21)
next
  case (FAssNone e1 h l sh a h' l' sh' e2 v h2 l2 sh2 C fs F D)
  have "PROP ?P e1 h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAssNone.prems
  obtain ls1 where 1: "?Post e1 h l sh (addr a) h' l' sh' Vs ls ls1"
    "size ls = size ls1"   by(auto intro!:eval1_preserves_len)
  have "PROP ?P e2 h' l' sh' (Val v) h2 l2 sh2 Vs ls1" by fact
  with 1 FAssNone.prems
  obtain ls2 where 2: "?Post e2 h' l' sh' (Val v) h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 FAssNone show ?case by(auto intro!:FAssNone1)
next
  case (FAssStatic e1 h l sh a h' l' sh' e2 v h2 l2 sh2 C fs F t D)
  have "PROP ?P e1 h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAssStatic.prems
  obtain ls1 where 1: "?Post e1 h l sh (addr a) h' l' sh' Vs ls ls1"
    "size ls = size ls1"   by(auto intro!:eval1_preserves_len)
  have "PROP ?P e2 h' l' sh' (Val v) h2 l2 sh2 Vs ls1" by fact
  with 1 FAssStatic.prems
  obtain ls2 where 2: "?Post e2 h' l' sh' (Val v) h2 l2 sh2 Vs ls1 ls2"  by(auto)
  from 1 2 FAssStatic show ?case by(auto intro!:FAssStatic1)
next
  case SFAss then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (SFAssInit e2 h l sh v h1 l1 sh1 C F t D v' h' l' sh' sfs i sfs' sh'')
  have "PROP ?P e2 h l sh (Val v) h1 l1 sh1 Vs ls" by fact
  with SFAssInit.prems
  obtain ls1 where 1: "?Post e2 h l sh (Val v) h1 l1 sh1 Vs ls ls1" "length ls = length ls1"
    by(auto intro!:eval1_preserves_len)
  then have Init_size: "length Vs  length ls1" using SFAssInit.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False)  unit) h1 l1 sh1 (Val v') h' l' sh' Vs ls1" by fact
  with 1 Init_size SFAssInit.prems
  obtain ls2 where 2: "?Post (INIT D ([D],False)  unit) h1 l1 sh1 (Val v') h' l' sh' Vs ls1 ls2"
    by auto
  from 1 2 SFAssInit show ?case
    by(auto simp add: comp_def
                intro!: SFAssInit1 dest!:evals_final)
next
  case (SFAssInitThrow e2 h l sh v h1 l1 sh1 C F t D a h2 l2 sh2)
  have "PROP ?P e2 h l sh (Val v) h1 l1 sh1 Vs ls" by fact
  with SFAssInitThrow.prems
  obtain ls1 where 1: "?Post e2 h l sh (Val v) h1 l1 sh1 Vs ls ls1" "length ls = length ls1"
    by(auto intro!:eval1_preserves_len)
  then have Init_size: "length Vs  length ls1" using SFAssInitThrow.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False)  unit) h1 l1 sh1 (throw a) h2 l2 sh2 Vs ls1" by fact
  with 1 Init_size SFAssInitThrow.prems
  obtain ls2 where 2: "?Post (INIT D ([D],False)  unit) h1 l1 sh1 (throw a) h2 l2 sh2 Vs ls1 ls2"
    by auto
  from 1 2 SFAssInitThrow show ?case
    by(auto simp add: comp_def
                intro!: SFAssInitThrow1 dest!:evals_final)
next
  case SFAssThrow then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (SFAssNone e2 h l sh v h2 l2 sh2 C F D)
  have "PROP ?P e2 h l sh (Val v) h2 l2 sh2 Vs ls" by fact
  with SFAssNone.prems
  obtain ls2 where 2: "?Post e2 h l sh (Val v) h2 l2 sh2 Vs ls ls2" by(auto)
  from 2 SFAssNone show ?case by(rule_tac x = ls2 in exI, auto elim!: SFAssNone1)
next
  case SFAssNonStatic then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (CallNull e h l sh h1 l1 sh1 es vs h2 l2 sh2 M)
  have "PROP ?P e h l sh null h1 l1 sh1 Vs ls" by fact
  with CallNull.prems
  obtain ls1 where 1: "?Post e h l sh null h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?Ps es h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1" by fact
  with 1 CallNull.prems
  obtain ls2 where 2: "?Posts es h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1 ls2" by(auto)
  from 1 2 CallNull show ?case
    by (auto simp add: comp_def elim!: CallNull1)
next
  case CallObjThrow thus ?case  by(fastforce intro:eval1_evals1.intros)
next
  case (CallParamsThrow e h l sh v h1 l1 sh1 es vs ex es' h2 l2 sh2 M)
  have "PROP ?P e h l sh (Val v) h1 l1 sh1 Vs ls" by fact
  with CallParamsThrow.prems
  obtain ls1 where 1: "?Post e h l sh (Val v) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?Ps es h1 l1 sh1 (map Val vs @ throw ex # es') h2 l2 sh2 Vs ls1" by fact
  with 1 CallParamsThrow.prems
  obtain ls2 where 2: "?Posts es h1 l1 sh1 (map Val vs @ throw ex # es') h2 l2 sh2 Vs ls1 ls2" by(auto)
  from 1 2 CallParamsThrow show ?case
    by (auto simp add: comp_def
             elim!: CallParamsThrow1 dest!:evals_final)
next
  case (CallNone e h l sh a h1 l1 sh1 ps vs h2 l2 sh2 C fs M)
  have "PROP ?P e h l sh (addr a) h1 l1 sh1 Vs ls" by fact
  with CallNone.prems
  obtain ls1 where 1: "?Post e h l sh (addr a) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?Ps ps h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1" by fact
  with 1 CallNone.prems
  obtain ls2 where 2: "?Posts ps h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1 ls2" by(auto)
  from 1 2 CallNone show ?case
    by (auto simp add: comp_def
             elim!: CallNone1 dest!:evals_final sees_method_compPD)
next
  case (CallStatic e h l sh a h1 l1 sh1 ps vs h2 l2 sh2 C fs M Ts T pns body D)
  have "PROP ?P e h l sh (addr a) h1 l1 sh1 Vs ls" by fact
  with CallStatic.prems
  obtain ls1 where 1: "?Post e h l sh (addr a) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  let ?Vs = pns
  have mdecl: "P  C sees M,Static: TsT = (pns, body) in D" by fact
  have mdecl1: "compP1 P  C sees M,Static: TsT = (compE1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  have "PROP ?Ps ps h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1" by fact
  with 1 CallStatic.prems
  obtain ls2 where 2: "?Posts ps h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1 ls2" by(auto)
  from 1 2 mdecl1 CallStatic show ?case
    by (auto simp add: comp_def
             elim!: CallStatic1 dest!:evals_final)
next
  case (Call e h l sh a h1 l1 sh1 es vs h2 l2 sh2 C fs M Ts T pns body D l2' b' h3 l3 sh3)
  have "PROP ?P e h l sh (addr a) h1 l1 sh1 Vs ls" by fact
  with Call.prems
  obtain ls1 where 1: "?Post e h l sh (addr a) h1 l1 sh1 Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?Ps es h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1" by fact
  with 1 Call.prems
  obtain ls2 where 2: "?Posts es h1 l1 sh1 (map Val vs) h2 l2 sh2 Vs ls1 ls2"
    "size ls1 = size ls2"    by(auto intro!:evals1_preserves_len)
  let ?Vs = "this#pns"
  let ?ls = "Addr a # vs @ replicate (max_vars body) undefined"
  have mdecl: "P  C sees M,NonStatic: TsT = (pns, body) in D" by fact
  have fv_body: "fv body  set ?Vs" and wf_size: "size Ts = size pns"
    using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have mdecl1: "compP1 P  C sees M,NonStatic: TsT = (compE1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  have [simp]: "l2' = [this  Addr a, pns [↦] vs]" by fact
  have Call_size: "size vs = size pns" by fact
  have "PROP ?P body h2 l2' sh2 b' h3 l3 sh3 ?Vs ?ls" by fact
  with 1 2 fv_body Call_size Call.prems
  obtain ls3 where 3: "?Post body h2 l2' sh2 b' h3 l3 sh3 ?Vs ?ls ls3"  by(auto)
  have hp: "h2 a = Some (C, fs)" by fact
  from 1 2 3 hp mdecl1 wf_size Call_size show ?case
    by(fastforce simp add: comp_def
                intro!: Call1 dest!:evals_final)
next
  case (SCallParamsThrow es h l sh vs ex es' h2 l2 sh2 C M)
  have "PROP ?Ps es h l sh (map Val vs @ throw ex # es') h2 l2 sh2 Vs ls" by fact
  with SCallParamsThrow.prems
  obtain ls2 where 2: "?Posts es h l sh (map Val vs @ throw ex # es') h2 l2 sh2 Vs ls ls2" by(auto)
  from 2 SCallParamsThrow show ?case
    by (fastforce simp add: comp_def
             elim!: SCallParamsThrow1 dest!:evals_final)
next
  case (SCall ps h l sh vs h2 l2 sh2 C M Ts T pns body D sfs l2' e' h3 l3 sh3)
  have "PROP ?Ps ps h l sh (map Val vs) h2 l2 sh2 Vs ls" by fact
  with SCall.prems
  obtain ls2 where 2: "?Posts ps h l sh (map Val vs) h2 l2 sh2 Vs ls ls2"
    "size ls = size ls2"    by(auto intro!:evals1_preserves_len)
  let ?Vs = "pns"
  let ?ls = "vs @ replicate (max_vars body) undefined"
  have mdecl: "P  C sees M,Static: TsT = (pns, body) in D" by fact
  have fv_body: "fv body  set ?Vs" and wf_size: "size Ts = size pns"
    using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have mdecl1: "compP1 P  C sees M,Static: TsT = (compE1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  have [simp]: "l2' = [pns [↦] vs]" by fact
  have SCall_size: "size vs = size pns" by fact
  have "PROP ?P body h2 l2' sh2 e' h3 l3 sh3 ?Vs ?ls" by fact
  with 2 fv_body SCall_size SCall.prems
  obtain ls3 where 3: "?Post body h2 l2' sh2 e' h3 l3 sh3 ?Vs ?ls ls3"  by(auto)
  have shp: "sh2 D = (sfs, Done)  M = clinit  sh2 D = (sfs, Processing)" by fact
  from 2 3 shp mdecl1 wf_size SCall_size show ?case
    by(fastforce simp add: comp_def
                intro!: SCall1 dest!:evals_final)
next
  case (SCallNone ps h l sh vs h' l' sh' C M)
  have "PROP ?Ps ps h l sh (map Val vs) h' l' sh' Vs ls" by fact
  with SCallNone.prems
  obtain ls2 where 2: "?Posts ps h l sh (map Val vs) h' l' sh' Vs ls ls2" by(auto)
  from 2 SCallNone show ?case
    by(rule_tac x = ls2 in exI,
       auto simp add: comp_def elim!: SCallNone1 dest!:evals_final sees_method_compPD)
next
  case (SCallNonStatic ps h l sh vs h' l' sh' C M Ts T pns body D)
  let ?Vs = "this#pns"
  have mdecl: "P  C sees M,NonStatic: TsT = (pns, body) in D" by fact
  have mdecl1: "compP1 P  C sees M,NonStatic: TsT = (compE1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  have "PROP ?Ps ps h l sh (map Val vs) h' l' sh' Vs ls" by fact
  with SCallNonStatic.prems
  obtain ls2 where 2: "?Posts ps h l sh (map Val vs) h' l' sh' Vs ls ls2" by(auto)
  from 2 mdecl1 SCallNonStatic show ?case
    by (auto simp add: comp_def
             elim!: SCallNonStatic1 dest!:evals_final)
next
  case (SCallInitThrow ps h l sh vs h1 l1 sh1 C M Ts T pns body D a h2 l2 sh2)
  have "PROP ?Ps ps h l sh (map Val vs) h1 l1 sh1 Vs ls" by fact
  with SCallInitThrow.prems
  obtain ls1 where 1: "?Posts ps h l sh (map Val vs) h1 l1 sh1 Vs ls ls1" "length ls = length ls1"
    by(auto intro!:evals1_preserves_len)
  then have Init_size: "length Vs  length ls1" using SCallInitThrow.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False)  unit) h1 l1 sh1 (throw a) h2 l2 sh2 Vs ls1" by fact
  with 1 Init_size SCallInitThrow.prems
  obtain ls2 where 2: "?Post (INIT D ([D],False)  unit) h1 l1 sh1 (throw a) h2 l2 sh2 Vs ls1 ls2"
    by auto
  let ?Vs = "pns"
  have mdecl: "P  C sees M,Static: TsT = (pns, body) in D" by fact
  have mdecl1: "compP1 P  C sees M,Static: TsT = (compE1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  from 1 2 mdecl1 SCallInitThrow show ?case
    by(auto simp add: comp_def
                intro!: SCallInitThrow1 dest!:evals_final)
next
  case (SCallInit ps h l sh vs h1 l1 sh1 C M Ts T pns body D v' h2 l2 sh2 l2' e' h3 l3 sh3)
  have "PROP ?Ps ps h l sh (map Val vs) h1 l1 sh1 Vs ls" by fact
  with SCallInit.prems
  obtain ls1 where 1: "?Posts ps h l sh (map Val vs) h1 l1 sh1 Vs ls ls1" "length ls = length ls1"
    by(auto intro!:evals1_preserves_len)
  then have Init_size: "length Vs  length ls1" using SCallInit.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False)  unit) h1 l1 sh1 (Val v') h2 l2 sh2 Vs ls1" by fact
  with 1 Init_size SCallInit.prems
  obtain ls2 where 2: "?Post (INIT D ([D],False)  unit) h1 l1 sh1 (Val v') h2 l2 sh2 Vs ls1 ls2"
    by auto
  let ?Vs = "pns"
  let ?ls = "vs @ replicate (max_vars body) undefined"
  have mdecl: "P  C sees M,Static: TsT = (pns, body) in D" by fact
  have fv_body: "fv body  set ?Vs" and wf_size: "size Ts = size pns"
    using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have mdecl1: "compP1 P  C sees M,Static: TsT = (compE1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  have [simp]: "l2' = [pns [↦] vs]" by fact
  have SCall_size: "size vs = size pns" by fact
  have nclinit: "M  clinit" by fact
  have "PROP ?P body h2 l2' sh2 e' h3 l3 sh3 ?Vs ?ls" by fact
  with 2 fv_body SCall_size SCallInit.prems
  obtain ls3 where 3: "?Post body h2 l2' sh2 e' h3 l3 sh3 ?Vs ?ls ls3"  by(auto)
  have shp: "sfs. sh1 D = (sfs, Done)" by fact
  from 1 2 3 shp mdecl1 wf_size SCall_size nclinit show ?case
    by(auto simp add: comp_def
                intro!: SCallInit1 dest!:evals_final)
next
― ‹ init cases ›
  case InitFinal then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (InitNone sh C C' Cs e h l e' h' l' sh')
  let ?sh1 = "sh(C  (sblank P C, Prepared))"
  have "PROP ?P (INIT C' (C # Cs,False)  e) h l ?sh1 e' h' l' sh' Vs ls" by fact
  with InitNone.prems
  obtain ls2 where 2: "?Post (INIT C' (C # Cs,False)  e) h l ?sh1 e' h' l' sh' Vs ls ls2" by(auto)
  from 2 InitNone show ?case by (auto elim!: InitNone1)
next
  case InitDone then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case InitProcessing then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case InitError then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case InitObject then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (InitNonObject sh C sfs D fs ms sh' C' Cs e h l e' h1 l1 sh1)
  let ?f = "(λb (pns,body). compE1 (case b of NonStatic  this#pns | Static  pns) body)"
  have cls: "class (compP ?f P) C = (D,fs,map (compM ?f) ms)"
    by(rule class_compP[OF InitNonObject.hyps(3)])
  have "PROP ?P (INIT C' (D # C # Cs,False)  e) h l sh' e' h1 l1 sh1 Vs ls" by fact
  with InitNonObject.prems
  obtain ls2 where 2: "?Post (INIT C' (D # C # Cs,False)  e) h l sh' e' h1 l1 sh1 Vs ls ls2" by(auto)
  from 2 cls InitNonObject show ?case by (auto elim!: InitNonObject1)
next
  case InitRInit then show ?case by(fastforce intro:eval1_evals1.intros)
next
  case (RInit e h l sh v h' l' sh' C sfs i sh'' C' Cs e' e1 h1 l1 sh1)
  have "PROP ?P e h l sh (Val v) h' l' sh' Vs ls" by fact
  with RInit.prems
  obtain ls1 where 1: "?Post e h l sh (Val v) h' l' sh' Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have "PROP ?P (INIT C' (Cs,True)  e') h' l' sh'' e1 h1 l1 sh1 Vs ls1" by fact
  with 1 RInit.prems
  obtain ls2 where 2: "?Post (INIT C' (Cs,True)  e') h' l' sh'' e1 h1 l1 sh1 Vs ls1 ls2" by(auto)
  from 1 2 RInit show ?case by (auto elim!: RInit1)
next
  case (RInitInitFail e h l sh a h' l' sh' C sfs i sh'' D Cs e' e1 h1 l1 sh1)
  have "PROP ?P e h l sh (throw a) h' l' sh' Vs ls" by fact
  with RInitInitFail.prems
  obtain ls1 where 1: "?Post e h l sh (throw a) h' l' sh' Vs ls ls1"
    "size ls = size ls1"    by(auto intro!:eval1_preserves_len)
  have fv: "fv (RI (D,throw a) ; Cs  e')  set Vs"
    using RInitInitFail.hyps(1) eval_final RInitInitFail.prems(1) subset_eq by fastforce
  have l': "l' m [Vs [↦] ls1]" by (simp add: "1"(1))
  have "PROP ?P (RI (D,throw a) ; Cs  e') h' l' sh'' e1 h1 l1 sh1 Vs ls1" by fact
  with 1 eval_final[OF RInitInitFail.hyps(1)] RInitInitFail.prems
  obtain ls2 where 2: "?Post (RI (D,throw a) ; Cs  e') h' l' sh'' e1 h1 l1 sh1 Vs ls1 ls2"
    by fastforce
  from 1 2 RInitInitFail show ?case
    by(fastforce simp add: comp_def
                intro!: RInitInitFail1 dest!:eval_final)
next
  case RInitFailFinal then show ?case by(fastforce intro:eval1_evals1.intros)
qed
(*>*)


subsection‹Preservation of well-formedness›

text‹ The compiler preserves well-formedness. Is less trivial than it
may appear. We start with two simple properties: preservation of
well-typedness ›

lemma compE1_pres_wt: "Vs Ts U.
   P,[Vs[↦]Ts]  e :: U; size Ts = size Vs 
   compP f P,Ts 1 compE1 Vs e :: U"
and  "Vs Ts Us.
   P,[Vs[↦]Ts]  es [::] Us; size Ts = size Vs 
   compP f P,Ts 1 compEs1 Vs es [::] Us"
(*<*)
apply(induct e and es rule: compE1.induct compEs1.induct)
apply clarsimp
apply(fastforce)
apply clarsimp
apply(fastforce split:bop.splits)
apply (fastforce simp:map_upds_apply_eq_Some split:if_split_asm)
apply (fastforce simp:map_upds_apply_eq_Some split:if_split_asm)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply (fastforce dest!: sees_method_compP[where f = f])
apply (fastforce dest!: sees_method_compP[where f = f])
apply (fastforce simp:nth_append)
apply (fastforce)
apply (fastforce)
apply (fastforce)
apply (fastforce)
apply (fastforce simp:nth_append)
apply simp
apply simp
apply simp
apply (fastforce)
done
(*>*)

text‹\noindent and the correct block numbering: ›

lemma: "Vs n. size Vs = n (compE1 Vs e) n"
and ℬs: "Vs n. size Vs = n  ℬs (compEs1 Vs es) n"
(*<*)by (induct e and es rule: ℬ.induct ℬs.induct)
        (force | simp,metis length_append_singleton)+(*>*)

text‹ The main complication is preservation of definite assignment
@{term"𝒟"}. ›

lemma image_last_index: "A  set(xs@[x])  last_index (xs @ [x]) ` A =
  (if x  A then insert (size xs) (last_index xs ` (A-{x})) else last_index xs ` A)"
(*<*)
by(auto simp:image_def)
(*>*)


lemma A_compE1_None[simp]:
      "Vs. 𝒜 e = None  𝒜 (compE1 Vs e) = None"
and "Vs. 𝒜s es = None  𝒜s (compEs1 Vs es) = None"
(*<*)by(induct e and es rule: compE1.induct compEs1.induct)(auto simp:hyperset_defs)(*>*)


lemma A_compE1:
      "A Vs.  𝒜 e = A; fv e  set Vs   𝒜 (compE1 Vs e) = last_index Vs ` A"
and "A Vs.  𝒜s es = A; fvs es  set Vs   𝒜s (compEs1 Vs es) = last_index Vs ` A"
(*<*)
proof(induct e and es rule: fv.induct fvs.induct)
  case (Block V' T e)
  hence "fv e  set (Vs@[V'])" by fastforce
  moreover obtain B where "𝒜 e = B"
    using Block.prems by(simp add: hyperset_defs)
  moreover from calculation have "B  set (Vs@[V'])" by(auto dest!:A_fv)
  ultimately show ?case using Block
    by(auto simp add: hyperset_defs image_last_index last_index_size_conv)
next
  case (TryCatch e1 C V' e2)
  hence fve2: "fv e2  set (Vs@[V'])" by auto
  show ?case
  proof (cases "𝒜 e1")
    assume A1: "𝒜 e1 = None"
    then obtain A2 where A2: "𝒜 e2 = A2" using TryCatch
      by(simp add:hyperset_defs)
    hence "A2  set (Vs@[V'])" using TryCatch.prems A_fv[OF A2] by simp blast
    thus ?thesis using TryCatch fve2 A1 A2
      by(auto simp add:hyperset_defs image_last_index last_index_size_conv)
  next
    fix A1 assume A1: "𝒜 e1 =  A1"
    show ?thesis
    proof (cases  "𝒜 e2")
      assume A2: "𝒜 e2 = None"
      then show ?case using TryCatch A1 by(simp add:hyperset_defs)
    next
      fix A2 assume A2: "𝒜 e2 = A2"
      have "A1  set Vs" using TryCatch.prems A_fv[OF A1] by simp blast
      moreover
      have "A2  set (Vs@[V'])" using TryCatch.prems A_fv[OF A2] by simp blast
      ultimately show ?thesis using TryCatch A1 A2
        by (auto simp add: Diff_subset_conv last_index_size_conv subsetD hyperset_defs
                 dest!: sym [of _ A])
    qed
  qed
next
  case (Cond e e1 e2)
  { assume "𝒜 e = None  𝒜 e1 = None  𝒜 e2 = None"
    hence ?case using Cond by(auto simp add:hyperset_defs image_Un)
  }
  moreover
  { fix A A1 A2
    assume "𝒜 e = A" and A1: "𝒜 e1 = A1" and A2: "𝒜 e2 = A2"
    moreover
    have "A1  set Vs" using Cond.prems A_fv[OF A1] by simp blast
    moreover
    have "A2  set Vs" using Cond.prems A_fv[OF A2] by simp blast
    ultimately have ?case using Cond
      by(auto simp add:hyperset_defs image_Un
          inj_on_image_Int[OF inj_on_last_index])
  }
  ultimately show ?case by fastforce
qed (auto simp add:hyperset_defs)
(*>*)


lemma D_None[iff]: "𝒟 (e::'a exp) None" and [iff]: "𝒟s (es::'a exp list) None"
(*<*)by(induct e and es rule: 𝒟.induct 𝒟s.induct)(simp_all)(*>*)


lemma D_last_index_compE1:
      "A Vs.  A  set Vs; fv e  set Vs  
                𝒟 e A  𝒟 (compE1 Vs e) last_index Vs ` A"
and "A Vs.  A  set Vs; fvs es  set Vs  
                𝒟s es A  𝒟s (compEs1 Vs es) last_index Vs ` A"
(*<*)
proof(induct e and es rule: 𝒟.induct 𝒟s.induct)
  case (BinOp e1 bop e2)
  hence IH1: "𝒟 (compE1 Vs e1) last_index Vs ` A" by simp
  show ?case
  proof (cases "𝒜 e1")
    case None thus ?thesis using BinOp by simp
  next
    case (Some A1)
    have indexA1: "𝒜 (compE1 Vs e1) = last_index Vs ` A1"
      using A_compE1[OF Some] BinOp.prems  by auto
    have "A  A1  set Vs" using BinOp.prems A_fv[OF Some] by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` (A  A1)" using BinOp Some by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` A  last_index Vs ` A1"
      by(simp add: image_Un)
    thus ?thesis using IH1 indexA1 by auto
  qed
next
  case (FAss e1 F D e2)
  hence IH1: "𝒟 (compE1 Vs e1) last_index Vs ` A" by simp
  show ?case
  proof (cases "𝒜 e1")
    case None thus ?thesis using FAss by simp
  next
    case (Some A1)
    have indexA1: "𝒜 (compE1 Vs e1) = last_index Vs ` A1"
      using A_compE1[OF Some] FAss.prems  by auto
    have "A  A1  set Vs" using FAss.prems A_fv[OF Some] by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` (A  A1)" using FAss Some by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` A  last_index Vs ` A1"
      by(simp add: image_Un)
    thus ?thesis using IH1 indexA1 by auto
  qed
next
  case (Call e1 M es)
  hence IH1: "𝒟 (compE1 Vs e1) last_index Vs ` A" by simp
  show ?case
  proof (cases "𝒜 e1")
    case None thus ?thesis using Call by simp
  next
    case (Some A1)
    have indexA1: "𝒜 (compE1 Vs e1) = last_index Vs ` A1"
      using A_compE1[OF Some] Call.prems  by auto
    have "A  A1  set Vs" using Call.prems A_fv[OF Some] by auto
    hence "𝒟s (compEs1 Vs es) last_index Vs ` (A  A1)" using Call Some by auto
    hence "𝒟s (compEs1 Vs es) last_index Vs ` A  last_index Vs ` A1"
      by(simp add: image_Un)
    thus ?thesis using IH1 indexA1 by auto
  qed
next
  case (TryCatch e1 C V e2)
  have " A{V}  set(Vs@[V]); fv e2  set(Vs@[V]); 𝒟 e2 A{V} 
        𝒟 (compE1 (Vs@[V]) e2) last_index (Vs@[V]) ` (A{V})" by fact
  hence "𝒟 (compE1 (Vs@[V]) e2) last_index (Vs@[V]) ` (A{V})"
    using TryCatch.prems by(simp add:Diff_subset_conv)
  moreover have "last_index (Vs@[V]) ` A  last_index Vs ` A  {size Vs}"
    using TryCatch.prems by(auto simp add: image_last_index split:if_split_asm)
  ultimately show ?case using TryCatch
    by(auto simp:hyperset_defs elim!:D_mono')
next
  case (Seq e1 e2)
  hence IH1: "𝒟 (compE1 Vs e1) last_index Vs ` A" by simp
  show ?case
  proof (cases "𝒜 e1")
    case None thus ?thesis using Seq by simp
  next
    case (Some A1)
    have indexA1: "𝒜 (compE1 Vs e1) = last_index Vs ` A1"
      using A_compE1[OF Some] Seq.prems  by auto
    have "A  A1  set Vs" using Seq.prems A_fv[OF Some] by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` (A  A1)" using Seq Some by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` A  last_index Vs ` A1"
      by(simp add: image_Un)
    thus ?thesis using IH1 indexA1 by auto
  qed
next
  case (Cond e e1 e2)
  hence IH1: "𝒟 (compE1 Vs e) last_index Vs ` A" by simp
  show ?case
  proof (cases "𝒜 e")
    case None thus ?thesis using Cond by simp
  next
    case (Some B)
    have indexB: "𝒜 (compE1 Vs e) = last_index Vs ` B"
      using A_compE1[OF Some] Cond.prems  by auto
    have "A  B  set Vs" using Cond.prems A_fv[OF Some] by auto
    hence "𝒟 (compE1 Vs e1) last_index Vs ` (A  B)"
      and "𝒟 (compE1 Vs e2) last_index Vs ` (A  B)"
      using Cond Some by auto
    hence "𝒟 (compE1 Vs e1) last_index Vs ` A  last_index Vs ` B"
      and "𝒟 (compE1 Vs e2) last_index Vs ` A  last_index Vs ` B"
      by(simp add: image_Un)+
    thus ?thesis using IH1 indexB by auto
  qed
next
  case (While e1 e2)
  hence IH1: "𝒟 (compE1 Vs e1) last_index Vs ` A" by simp
  show ?case
  proof (cases "𝒜 e1")
    case None thus ?thesis using While by simp
  next
    case (Some A1)
    have indexA1: "𝒜 (compE1 Vs e1) = last_index Vs ` A1"
      using A_compE1[OF Some] While.prems  by auto
    have "A  A1  set Vs" using While.prems A_fv[OF Some] by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` (A  A1)" using While Some by auto
    hence "𝒟 (compE1 Vs e2) last_index Vs ` A  last_index Vs ` A1"
      by(simp add: image_Un)
    thus ?thesis using IH1 indexA1 by auto
  qed
next
  case (Block V T e)
  have " A-{V}  set(Vs@[V]); fv e  set(Vs@[V]); 𝒟 e A-{V}  
        𝒟 (compE1 (Vs@[V]) e) last_index (Vs@[V]) ` (A-{V})" by fact
  hence "𝒟 (compE1 (Vs@[V]) e) last_index (Vs@[V]) ` (A-{V})"
    using Block.prems by(simp add:Diff_subset_conv)
  moreover have "size Vs  last_index Vs ` A"
    using Block.prems by(auto simp add:image_def size_last_index_conv)
  ultimately show ?case using Block
    by(auto simp add: image_last_index Diff_subset_conv hyperset_defs elim!: D_mono')
next
  case (Cons_exp e1 es)
  hence IH1: "𝒟 (compE1 Vs e1) last_index Vs ` A" by simp
  show ?case
  proof (cases "𝒜 e1")
    case None thus ?thesis using Cons_exp by simp
  next
    case (Some A1)
    have indexA1: "𝒜 (compE1 Vs e1) = last_index Vs ` A1"
      using A_compE1[OF Some] Cons_exp.prems  by auto
    have "A  A1  set Vs" using Cons_exp.prems A_fv[OF Some] by auto
    hence "𝒟s (compEs1 Vs es) last_index Vs ` (A  A1)" using Cons_exp Some by auto
    hence "𝒟s (compEs1 Vs es) last_index Vs ` A  last_index Vs ` A1"
      by(simp add: image_Un)
    thus ?thesis using IH1 indexA1 by auto
  qed
qed (simp_all add:hyperset_defs)
(*>*)


lemma last_index_image_set: "distinct xs  last_index xs ` set xs = {..<size xs}"
(*<*)by(induct xs rule:rev_induct) (auto simp add: image_last_index)(*>*)


lemma D_compE1:
  " 𝒟 e set Vs; fv e  set Vs; distinct Vs   𝒟 (compE1 Vs e) {..<length Vs}"
(*<*)by(fastforce dest!: D_last_index_compE1[OF subset_refl] simp add:last_index_image_set)(*>*)


lemma D_compE1':
assumes "𝒟 e set(V#Vs)" and "fv e  set(V#Vs)" and "distinct(V#Vs)"
shows "𝒟 (compE1 (V#Vs) e) {..length Vs}"
(*<*)
proof -
  have "{..size Vs} = {..<size(V#Vs)}" by auto
  thus ?thesis using assms by (simp only:)(rule D_compE1)
qed
(*>*)

lemma compP1_pres_wf: "wf_J_prog P  wf_J1_prog (compP1 P)"
(*<*)
apply simp
apply(rule wf_prog_compPI)
 prefer 2 apply assumption
apply(case_tac m)
apply(simp add:wf_mdecl_def wf_J1_mdecl_def)
apply(clarify) apply(rename_tac C M b Ts T x1 x2 pns body)
apply(case_tac b)
 apply clarsimp
 apply(frule WT_fv)
 apply(auto intro!: compE1_pres_wt D_compE1)[1]
apply clarsimp
apply(frule WT_fv)
apply(fastforce intro!: compE1_pres_wt D_compE1' ℬ)
done
(*>*)


end

Theory Compiler2

(*  Title:      JinjaDCI/Compiler/Compiler2.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Compiler/Compiler2.thy by Tobias Nipkow
*)

section ‹ Compilation Stage 2 ›

theory Compiler2
imports PCompiler J1 "../JVM/JVMExec"
begin

lemma bop_expr_length_aux [simp]:
 "length (case bop of Eq  [CmpEq] | Add  [IAdd]) = Suc 0"
 by(cases bop, simp+)

primrec compE2 :: "expr1  instr list"
  and compEs2 :: "expr1 list  instr list" where
  "compE2 (new C) = [New C]"
| "compE2 (Cast C e) = compE2 e @ [Checkcast C]"
| "compE2 (Val v) = [Push v]"
| "compE2 (e1 «bop» e2) = compE2 e1 @ compE2 e2 @ 
  (case bop of Eq  [CmpEq]
            | Add  [IAdd])"
| "compE2 (Var i) = [Load i]"
| "compE2 (i:=e) = compE2 e @ [Store i, Push Unit]"
| "compE2 (eF{D}) = compE2 e @ [Getfield F D]"
| "compE2 (CsF{D}) = [Getstatic C F D]"
| "compE2 (e1F{D} := e2) =
       compE2 e1 @ compE2 e2 @ [Putfield F D, Push Unit]"
| "compE2 (CsF{D} := e2) =
       compE2 e2 @ [Putstatic C F D, Push Unit]"
| "compE2 (eM(es)) = compE2 e @ compEs2 es @ [Invoke M (size es)]"
| "compE2 (CsM(es)) = compEs2 es @ [Invokestatic C M (size es)]"
| "compE2 ({i:T; e}) = compE2 e"
| "compE2 (e1;;e2) = compE2 e1 @ [Pop] @ compE2 e2"
| "compE2 (if (e) e1 else e2) =
        (let cnd   = compE2 e;
             thn   = compE2 e1;
             els   = compE2 e2;
             test  = IfFalse (int(size thn + 2)); 
             thnex = Goto (int(size els + 1))
         in cnd @ [test] @ thn @ [thnex] @ els)"
| "compE2 (while (e) c) =
        (let cnd   = compE2 e;
             bdy   = compE2 c;
             test  = IfFalse (int(size bdy + 3)); 
             loop  = Goto (-int(size bdy + size cnd + 2))
         in cnd @ [test] @ bdy @ [Pop] @ [loop] @ [Push Unit])"
| "compE2 (throw e) = compE2 e @ [instr.Throw]"
| "compE2 (try e1 catch(C i) e2) =
   (let catch = compE2 e2
    in compE2 e1 @ [Goto (int(size catch)+2), Store i] @ catch)"
| "compE2 (INIT C (Cs,b)  e) = []"
| "compE2 (RI(C,e);Cs  e') = []"

| "compEs2 []     = []"
| "compEs2 (e#es) = compE2 e @ compEs2 es"

text‹ Compilation of exception table. Is given start address of code
to compute absolute addresses necessary in exception table. ›

primrec compxE2  :: "expr1       pc  nat  ex_table"
  and compxEs2 :: "expr1 list  pc  nat  ex_table" where
  "compxE2 (new C) pc d = []"
| "compxE2 (Cast C e) pc d = compxE2 e pc d"
| "compxE2 (Val v) pc d = []"
| "compxE2 (e1 «bop» e2) pc d =
   compxE2 e1 pc d @ compxE2 e2 (pc + size(compE2 e1)) (d+1)"
| "compxE2 (Var i) pc d = []"
| "compxE2 (i:=e) pc d = compxE2 e pc d"
| "compxE2 (eF{D}) pc d = compxE2 e pc d"
| "compxE2 (CsF{D}) pc d = []"
| "compxE2 (e1F{D} := e2) pc d =
   compxE2 e1 pc d @ compxE2 e2 (pc + size(compE2 e1)) (d+1)"
| "compxE2 (CsF{D} := e2) pc d = compxE2 e2 pc d"
| "compxE2 (eM(es)) pc d =
   compxE2 e pc d @ compxEs2 es (pc + size(compE2 e)) (d+1)"
| "compxE2 (CsM(es)) pc d = compxEs2 es pc d"
| "compxE2 ({i:T; e}) pc d = compxE2 e pc d"
| "compxE2 (e1;;e2) pc d =
   compxE2 e1 pc d @ compxE2 e2 (pc+size(compE2 e1)+1) d"
| "compxE2 (if (e) e1 else e2) pc d =
        (let pc1   = pc + size(compE2 e) + 1;
             pc2   = pc1 + size(compE2 e1) + 1
         in compxE2 e pc d @ compxE2 e1 pc1 d @ compxE2 e2 pc2 d)"
| "compxE2 (while (b) e) pc d =
   compxE2 b pc d @ compxE2 e (pc+size(compE2 b)+1) d"
| "compxE2 (throw e) pc d = compxE2 e pc d"
| "compxE2 (try e1 catch(C i) e2) pc d =
   (let pc1 = pc + size(compE2 e1)
    in compxE2 e1 pc d @ compxE2 e2 (pc1+2) d @ [(pc,pc1,C,pc1+1,d)])"
| "compxE2 (INIT C (Cs, b)  e) pc d = []"
| "compxE2 (RI(C, e);Cs  e') pc d = []"

| "compxEs2 [] pc d    = []"
| "compxEs2 (e#es) pc d = compxE2 e pc d @ compxEs2 es (pc+size(compE2 e)) (d+1)"

primrec max_stack :: "expr1  nat"
  and max_stacks :: "expr1 list  nat" where
  "max_stack (new C) = 1"
| "max_stack (Cast C e) = max_stack e"
| "max_stack (Val v) = 1"
| "max_stack (e1 «bop» e2) = max (max_stack e1) (max_stack e2) + 1"
| "max_stack (Var i) = 1"
| "max_stack (i:=e) = max_stack e"
| "max_stack (eF{D}) = max_stack e"
| "max_stack (CsF{D}) = 1"
| "max_stack (e1F{D} := e2) = max (max_stack e1) (max_stack e2) + 1"
| "max_stack (CsF{D} := e2) = max_stack e2"
| "max_stack (eM(es)) = max (max_stack e) (max_stacks es) + 1"
| "max_stack (CsM(es)) = max_stacks es + 1"
| "max_stack ({i:T; e}) = max_stack e"
| "max_stack (e1;;e2) = max (max_stack e1) (max_stack e2)"
| "max_stack (if (e) e1 else e2) =
  max (max_stack e) (max (max_stack e1) (max_stack e2))"
| "max_stack (while (e) c) = max (max_stack e) (max_stack c)"
| "max_stack (throw e) = max_stack e"
| "max_stack (try e1 catch(C i) e2) = max (max_stack e1) (max_stack e2)"
 
| "max_stacks [] = 0"
| "max_stacks (e#es) = max (max_stack e) (1 + max_stacks es)"

lemma max_stack1': "¬sub_RI e  1  max_stack e"
(*<*)by(induct e) (simp_all add:max_def)(*>*)

lemma compE2_not_Nil': "¬sub_RI e  compE2 e  []"
(*<*)by(induct e) auto(*>*)

lemma compE2_nRet: "i. i  set (compE2 e1)  i  Return"
 and "i. i  set (compEs2 es1)  i  Return"
 by(induct rule: compE2.induct compEs2.induct, auto simp: nth_append split: bop.splits)


definition compMb2 :: "staticb  expr1  jvm_method"
where
  "compMb2    λb body.
  let ins = compE2 body @ [Return];
      xt = compxE2 body 0 0
  in (max_stack body, max_vars body, ins, xt)"

definition compP2 :: "J1_prog  jvm_prog"
where
  "compP2    compP compMb2"

(*<*)
declare compP2_def [simp]
(*>*)

lemma compMb2 [simp]:
  "compMb2 b e = (max_stack e, max_vars e,
                   compE2 e @ [Return], compxE2 e 0 0)"
(*<*)by (simp add: compMb2_def)(*>*)

end

Theory Correctness2

(*  Title:      JinjaDCI/Compiler/Correctness2.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Compiler/Correctness2.thy by Tobias Nipkow
*)

section ‹ Correctness of Stage 2 ›

theory Correctness2
imports "HOL-Library.Sublist" Compiler2 J1WellForm "../J/EConform"
begin

(*<*)hide_const (open) Throw(*>*)

subsection‹ Instruction sequences ›

text‹ How to select individual instructions and subsequences of
instructions from a program given the class, method and program
counter. ›

definition before :: "jvm_prog  cname  mname  nat  instr list  bool"
   ("(_,_,_,_/  _)" [51,0,0,0,51] 50) where
 "P,C,M,pc  is  prefix is (drop pc (instrs_of P C M))"

definition at :: "jvm_prog  cname  mname  nat  instr  bool"
   ("(_,_,_,_/  _)" [51,0,0,0,51] 50) where
 "P,C,M,pc  i  (is. drop pc (instrs_of P C M) = i#is)"

lemma [simp]: "P,C,M,pc  []"
(*<*)by(simp add:before_def)(*>*)


lemma [simp]: "P,C,M,pc  (i#is) = (P,C,M,pc  i  P,C,M,pc + 1  is)"
(*<*)by(fastforce simp add:before_def at_def prefix_def drop_Suc drop_tl)(*>*)

(*<*)
declare drop_drop[simp del]
(*>*)


lemma [simp]: "P,C,M,pc  (is1 @ is2) = (P,C,M,pc  is1  P,C,M,pc + size is1  is2)"
(*<*)
apply(simp add:before_def prefix_def)
apply(subst add.commute)
apply(simp add: drop_drop[symmetric])
apply fastforce
done
(*>*)

(*<*)
declare drop_drop[simp]
(*>*)


lemma [simp]: "P,C,M,pc  i  instrs_of P C M ! pc = i"
(*<*)by(clarsimp simp add:at_def strict_prefix_def nth_via_drop)(*>*)

lemma beforeM:
  "P  C sees M,b: TsT = body in D 
  compP2 P,D,M,0  compE2 body @ [Return]"
(*<*)
apply(drule sees_method_idemp)
apply(simp add:before_def compP2_def compMb2_def)
done
(*>*)

text‹ This lemma executes a single instruction by rewriting: ›

lemma [simp]:
  "P,C,M,pc  instr 
  (P  (None, h, (vs,ls,C,M,pc,ics) # frs, sh) -jvm→ σ') =
  ((None, h, (vs,ls,C,M,pc,ics) # frs, sh) = σ' 
   (σ. exec(P,(None, h, (vs,ls,C,M,pc,ics) # frs, sh)) = Some σ  P  σ -jvm→ σ'))"
(*<*)
apply(simp only: exec_all_def)
apply(blast intro: converse_rtranclE converse_rtrancl_into_rtrancl)
done
(*>*)


subsection‹ Exception tables ›

definition pcs :: "ex_table  nat set"
where
  "pcs xt    (f,t,C,h,d)  set xt. {f ..< t}"

lemma pcs_subset:
shows "(pc d. pcs(compxE2 e pc d)  {pc..<pc+size(compE2 e)})"
and "(pc d. pcs(compxEs2 es pc d)  {pc..<pc+size(compEs2 es)})"
(*<*)
apply(induct e and es rule: compxE2.induct compxEs2.induct)
apply (simp_all add:pcs_def)
apply (fastforce split:bop.splits)+
done
(*>*)


lemma [simp]: "pcs [] = {}"
(*<*)by(simp add:pcs_def)(*>*)


lemma [simp]: "pcs (x#xt) = {fst x ..< fst(snd x)}  pcs xt"
(*<*)by(auto simp add: pcs_def)(*>*)


lemma [simp]: "pcs(xt1 @ xt2) = pcs xt1  pcs xt2"
(*<*)by(simp add:pcs_def)(*>*)


lemma [simp]: "pc < pc0  pc0+size(compE2 e)  pc  pc  pcs(compxE2 e pc0 d)"
(*<*)using pcs_subset by fastforce(*>*)


lemma [simp]: "pc < pc0  pc0+size(compEs2 es)  pc  pc  pcs(compxEs2 es pc0 d)"
(*<*)using pcs_subset by fastforce(*>*)


lemma [simp]: "pc1 + size(compE2 e1)  pc2  pcs(compxE2 e1 pc1 d1)  pcs(compxE2 e2 pc2 d2) = {}"
(*<*)using pcs_subset by fastforce(*>*)


lemma [simp]: "pc1 + size(compE2 e)  pc2  pcs(compxE2 e pc1 d1)  pcs(compxEs2 es pc2 d2) = {}"
(*<*)using pcs_subset by fastforce(*>*)


lemma [simp]:
 "pc  pcs xt0  match_ex_table P C pc (xt0 @ xt1) = match_ex_table P C pc xt1"
(*<*)by (induct xt0) (auto simp: matches_ex_entry_def)(*>*)


lemma [simp]: " x  set xt; pc  pcs xt   ¬ matches_ex_entry P D pc x"
(*<*)by(auto simp:matches_ex_entry_def pcs_def)(*>*)


lemma [simp]:
assumes xe: "xe  set(compxE2 e pc d)" and outside: "pc' < pc  pc+size(compE2 e)  pc'"
shows "¬ matches_ex_entry P C pc' xe"
(*<*)
proof
  assume "matches_ex_entry P C pc' xe"
  with xe have "pc'  pcs(compxE2 e pc d)"
    by(force simp add:matches_ex_entry_def pcs_def)
  with outside show False by simp
qed
(*>*)


lemma [simp]:
assumes xe: "xe  set(compxEs2 es pc d)" and outside: "pc' < pc  pc+size(compEs2 es)  pc'"
shows "¬ matches_ex_entry P C pc' xe"
(*<*)
proof
  assume "matches_ex_entry P C pc' xe"
  with xe have "pc'  pcs(compxEs2 es pc d)"
    by(force simp add:matches_ex_entry_def pcs_def)
  with outside show False by simp
qed
(*>*)


lemma match_ex_table_app[simp]:
  "xte  set xt1. ¬ matches_ex_entry P D pc xte 
  match_ex_table P D pc (xt1 @ xt) = match_ex_table P D pc xt"
(*<*)by(induct xt1) simp_all(*>*)


lemma [simp]:
  "x  set xtab. ¬ matches_ex_entry P C pc x 
  match_ex_table P C pc xtab = None"
(*<*)using match_ex_table_app[where ?xt = "[]"] by fastforce(*>*)


lemma match_ex_entry:
  "matches_ex_entry P C pc (start, end, catch_type, handler) =
  (start  pc  pc < end   P  C * catch_type)"
(*<*)by(simp add:matches_ex_entry_def)(*>*)


definition caught :: "jvm_prog  pc  heap  addr  ex_table  bool" where
  "caught P pc h a xt 
  (entry  set xt. matches_ex_entry P (cname_of h a) pc entry)"

definition beforex :: "jvm_prog  cname  mname  ex_table  nat set  nat  bool"
              ("(2_,/_,/_ / _ /'/ _,/_)" [51,0,0,0,0,51] 50) where
  "P,C,M  xt / I,d 
  (xt0 xt1. ex_table_of P C M = xt0 @ xt @ xt1  pcs xt0  I = {}  pcs xt  I 
    (pc  I. C pc' d'. match_ex_table P C pc xt1 = (pc',d')  d'  d))"

definition dummyx :: "jvm_prog  cname  mname  ex_table  nat set  nat  bool"  ("(2_,_,_ / _ '/_,_)" [51,0,0,0,0,51] 50) where
  "P,C,M  xt/I,d  P,C,M  xt/I,d"

lemma beforexD1: "P,C,M  xt / I,d  pcs xt  I"
(*<*)by(auto simp add:beforex_def)(*>*)


lemma beforex_mono: " P,C,M  xt/I,d'; d'  d   P,C,M  xt/I,d"
(*<*)by(fastforce simp:beforex_def)(*>*)


lemma [simp]: "P,C,M  xt/I,d  P,C,M  xt/I,Suc d"
(*<*)by(fastforce intro:beforex_mono)(*>*)


lemma beforex_append[simp]:
  "pcs xt1  pcs xt2 = {} 
  P,C,M  xt1 @ xt2/I,d =
  (P,C,M  xt1/I-pcs xt2,d    P,C,M  xt2/I-pcs xt1,d  P,C,M  xt1@xt2/I,d)"
(*<*)
apply(rule iffI)
 prefer 2
 apply(simp add:dummyx_def)
apply(auto simp add: beforex_def dummyx_def)
 apply(rule_tac x = xt0 in exI)
 apply auto
apply(rule_tac x = "xt0@xt1" in exI)
apply auto
done
(*>*)


lemma beforex_appendD1:
  " P,C,M  xt1 @ xt2 @ [(f,t,D,h,d)] / I,d;
    pcs xt1  J; J  I; J  pcs xt2 = {} 
   P,C,M  xt1 / J,d"
(*<*)
apply(auto simp:beforex_def)
apply(rule exI,rule exI,rule conjI, rule refl)
apply(rule conjI, blast)
apply(auto)
apply(subgoal_tac "pc  pcs xt2")
 prefer 2 apply blast
apply (auto split:if_split_asm)
done
(*>*)


lemma beforex_appendD2:
  " P,C,M  xt1 @ xt2 @ [(f,t,D,h,d)] / I,d;
    pcs xt2  J; J  I; J  pcs xt1 = {} 
   P,C,M  xt2 / J,d"
(*<*)
apply(auto simp:beforex_def)
apply(rule_tac x = "xt0 @ xt1" in exI)
apply fastforce
done
(*>*)


lemma beforexM:
  "P  C sees M,b: TsT = body in D  compP2 P,D,M  compxE2 body 0 0/{..<size(compE2 body)},0"
(*<*)
apply(drule sees_method_idemp)
apply(drule sees_method_compP[where f = compMb2])
apply(simp add:beforex_def compP2_def compMb2_def)
apply(rule_tac x = "[]" in exI)
using pcs_subset apply fastforce
done
(*>*)


lemma match_ex_table_SomeD2:
 " match_ex_table P D pc (ex_table_of P C M) = (pc',d');
    P,C,M  xt/I,d; x  set xt. ¬ matches_ex_entry P D pc x; pc  I 
  d'  d"
(*<*)
apply(auto simp:beforex_def)
apply(subgoal_tac "pc  pcs xt0")
apply auto
done
(*>*)


lemma match_ex_table_SomeD1:
  " match_ex_table P D pc (ex_table_of P C M) = (pc',d');
     P,C,M  xt / I,d; pc  I; pc  pcs xt   d'  d"
(*<*)by(auto elim: match_ex_table_SomeD2)(*>*)


subsection‹ The correctness proof ›

(*<*)
declare nat_add_distrib[simp] caught_def[simp]
declare fun_upd_apply[simp del]
(*>*)

definition
  handle :: "jvm_prog  cname  mname  addr  heap  val list  val list  nat  init_call_status  frame list  sheap
                 jvm_state" where
  "handle P C M a h vs ls pc ics frs sh = find_handler P a h ((vs,ls,C,M,pc,ics) # frs) sh"

lemma aux_isin[simp]: " B  A; a  B   a  A"
(*<*)by blast(*>*)

lemma handle_frs_tl_neq:
 "ics_of f  No_ics
   (xp, h, f#frs, sh)  handle P C M xa h' vs l pc ics frs sh'"
 by(simp add: handle_def find_handler_frs_tl_neq del: find_handler.simps)

subsubsection "Correctness proof inductive hypothesis"

― ‹ frame definitions for use by correctness proof inductive hypothesis ›
fun calling_to_called :: "frame  frame" where
"calling_to_called (stk,loc,D,M,pc,ics) = (stk,loc,D,M,pc,case ics of Calling C Cs  Called (C#Cs))"

fun calling_to_scalled :: "frame  frame" where
"calling_to_scalled (stk,loc,D,M,pc,ics) = (stk,loc,D,M,pc,case ics of Calling C Cs  Called Cs)"

fun calling_to_calling :: "frame  cname  frame" where
"calling_to_calling (stk,loc,D,M,pc,ics) C' = (stk,loc,D,M,pc,case ics of Calling C Cs  Calling C' (C#Cs))"

fun calling_to_throwing :: "frame  addr  frame" where
"calling_to_throwing (stk,loc,D,M,pc,ics) a = (stk,loc,D,M,pc,case ics of Calling C Cs  Throwing (C#Cs) a)"

fun calling_to_sthrowing :: "frame  addr  frame" where
"calling_to_sthrowing (stk,loc,D,M,pc,ics) a = (stk,loc,D,M,pc,case ics of Calling C Cs  Throwing Cs a)"


― ‹ pieces of the correctness proof's inductive hypothesis, which depend on the
 expression being compiled) ›

fun Jcc_cond :: "J1_prog  ty list  cname  mname  val list  pc  init_call_status
    nat set  heap  sheap  expr1  bool" where
"Jcc_cond P E C M vs pc ics I h sh (INIT C0 (Cs,b)  e')
  = ((T. P,E,h,sh 1 INIT C0 (Cs,b)  e' : T)  unit = e'  ics = No_ics)" |
"Jcc_cond P E C M vs pc ics I h sh (RI(C',e0);Cs  e')
  = (((e0 = C'sclinit([])  (T. P,E,h,sh 1 RI(C',e0);Cs  e':T))
          ((a. e0 = Throw a)  (C  set(C'#Cs). is_class P C)))
       unit = e'  ics = No_ics)" |
"Jcc_cond P E C M vs pc ics I h sh (C'sM'(es))
  = (let e = (C'sM'(es))
     in if M' = clinit  es = [] then (T. P,E,h,sh 1 e:T)  (Cs. ics = Called Cs)
        else (compP2 P,C,M,pc  compE2 e  compP2 P,C,M  compxE2 e pc (size vs)/I,size vs
                   {pc..<pc+size(compE2 e)}  I  ¬sub_RI e  ics = No_ics)
    )" |
"Jcc_cond P E C M vs pc ics I h sh e
  = (compP2 P,C,M,pc  compE2 e  compP2 P,C,M  compxE2 e pc (size vs)/I,size vs
                   {pc..<pc+size(compE2 e)}  I  ¬sub_RI e  ics = No_ics)"


fun Jcc_frames :: "jvm_prog  cname  mname  val list  val list  pc  init_call_status
   frame list  expr1  frame list" where
"Jcc_frames P C M vs ls pc ics frs (INIT C0 (C'#Cs,b)  e')
  = (case b of False  (vs,ls,C,M,pc,Calling C' Cs) # frs
             | True  (vs,ls,C,M,pc,Called (C'#Cs)) # frs
    )" |
"Jcc_frames P C M vs ls pc ics frs (INIT C0 (Nil,b)  e')
  = (vs,ls,C,M,pc,Called [])#frs" |
"Jcc_frames P C M vs ls pc ics frs (RI(C',e0);Cs  e')
  = (case e0 of Throw a  (vs,ls,C,M,pc,Throwing (C'#Cs) a) # frs
              | _  (vs,ls,C,M,pc,Called (C'#Cs)) # frs )" |
"Jcc_frames P C M vs ls pc ics frs (C'sM'(es))
  = (if M' = clinit  es = []
     then create_init_frame P C'#(vs,ls,C,M,pc,ics)#frs
     else (vs,ls,C,M,pc,ics)#frs
    )" |
"Jcc_frames P C M vs ls pc ics frs e
  = (vs,ls,C,M,pc,ics)#frs"

fun Jcc_rhs :: "J1_prog  ty list  cname  mname  val list  val list  pc  init_call_status
   frame list  heap  val list  sheap  val  expr1  jvm_state" where
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v (INIT C0 (Cs,b)  e')
  = (None,h',(vs,ls,C,M,pc,Called [])#frs,sh')" |
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v (RI(C',e0);Cs  e')
  = (None,h',(vs,ls,C,M,pc,Called [])#frs,sh')" |
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v (C'sM'(es))
  = (let e = (C'sM'(es))
     in if M' = clinit  es = []
        then (None,h',(vs,ls,C,M,pc,ics)#frs,sh'(C'(fst(the(sh' C')),Done)))
        else (None,h',(v#vs,ls',C,M,pc+size(compE2 e),ics)#frs,sh')
    )" |
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v e
  = (None,h',(v#vs,ls',C,M,pc+size(compE2 e),ics)#frs,sh')"

fun Jcc_err :: "jvm_prog  cname  mname  heap  val list  val list  pc  init_call_status
   frame list  sheap  nat set  heap  val list  sheap  addr  expr1
   bool" where
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa (INIT C0 (Cs,b)  e')
  = (vs'. P  (None,h,Jcc_frames P C M vs ls pc ics frs (INIT C0 (Cs,b)  e'),sh)
           -jvm→ handle P C M xa h' (vs'@vs) ls pc ics frs sh')" |
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa (RI(C',e0);Cs  e')
  = (vs'. P  (None,h,Jcc_frames P C M vs ls pc ics frs (RI(C',e0);Cs  e'),sh)
           -jvm→ handle P C M xa h' (vs'@vs) ls pc ics frs sh')" |
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa (C'sM'(es))
  = (let e = (C'sM'(es))
     in if M' = clinit  es = []
        then case ics of
               Called Cs  P  (None,h,Jcc_frames P C M vs ls pc ics frs e,sh)
                       -jvm→ (None,h',(vs,ls,C,M,pc,Throwing Cs xa)#frs,(sh'(C'  (fst(the(sh' C')),Error))))
        else (pc1. pc  pc1  pc1 < pc + size(compE2 e) 
               ¬ caught P pc1 h' xa (compxE2 e pc (size vs)) 
               (vs'. P  (None,h,Jcc_frames P C M vs ls pc ics frs e,sh)
                      -jvm→ handle P C M xa h' (vs'@vs) ls' pc1 ics frs sh'))
    )" |
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa e
  = (pc1. pc  pc1  pc1 < pc + size(compE2 e) 
               ¬ caught P pc1 h' xa (compxE2 e pc (size vs)) 
               (vs'. P  (None,h,Jcc_frames P C M vs ls pc ics frs e,sh)
                      -jvm→ handle P C M xa h' (vs'@vs) ls' pc1 ics frs sh'))"

fun Jcc_pieces :: "J1_prog  ty list  cname  mname  heap  val list  val list  pc  init_call_status
   frame list  sheap  nat set  heap  val list  sheap  val  addr  expr1
   bool × frame list × jvm_state × bool" where
"Jcc_pieces P E C M h vs ls pc ics frs sh I h' ls' sh' v xa e
  = (Jcc_cond P E C M vs pc ics I h sh e, Jcc_frames (compP2 P) C M vs ls pc ics frs e,
      Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v e,
      Jcc_err (compP2 P) C M h vs ls pc ics frs sh I h' ls' sh' xa e)"

― ‹ @{text Jcc_pieces} lemmas ›

lemma nsub_RI_Jcc_pieces:
assumes [simp]: "P  compP2 P1"
  and nsub: "¬sub_RI e"
shows "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa e 
  = (let cond = P,C,M,pc  compE2 e  P,C,M  compxE2 e pc (size vs)/I,size vs
                   {pc..<pc+size(compE2 e)}  I  ics = No_ics;
         frs' = (vs,ls,C,M,pc,ics)#frs;
         rhs = (None,h',(v#vs,ls',C,M,pc+size(compE2 e),ics)#frs,sh');
         err = (pc1. pc  pc1  pc1 < pc + size(compE2 e) 
               ¬ caught P pc1 h' xa (compxE2 e pc (size vs)) 
               (vs'. P  (None,h,frs',sh) -jvm→ handle P C M xa h' (vs'@vs) ls' pc1 ics frs sh'))
     in (cond, frs',rhs, err)
    )"
proof -
  have NC: "C'. e  C'sclinit([])" using assms(2) proof(cases e) qed(simp_all)
  then show ?thesis using assms
  proof(cases e)
    case (SCall C M es)
    then have "M  clinit" using nsub by simp
    then show ?thesis using SCall nsub proof(cases es) qed(simp_all)
  qed(simp_all)
qed

lemma Jcc_pieces_Cast:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (Cast C' e)
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v' xa e
   = (True, frs0, (xp',h',(v'#vs',ls',C0,M',pc' - 1,ics')#frs',sh'),
        (pc1. pc  pc1  pc1 < pc + size(compE2 e) 
               ¬ caught P pc1 h1 xa (compxE2 e pc (size vs)) 
               (vs'. P  (None,h0,frs0,sh0) -jvm→ handle P C M xa h1 (vs'@vs) ls1 pc1 ics frs sh1)))"
proof -
  have pc: "{pc..<pc + length (compE2 e)}  I" using assms by clarsimp
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] pc by clarsimp
qed

lemma Jcc_pieces_BinOp1:
assumes
 "Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e «bop» e')
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "err. Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0
 (I - pcs (compxE2 e' (pc + length (compE2 e)) (Suc (length vs')))) h1 ls1 sh1 v' xa e
   = (True, frs0, (xp',h1,(v'#vs',ls1,C0,M',pc' - size (compE2 e') - 1,ics')#frs',sh1), err)"
proof -
  have bef: "compP compMb2 P,C0,M'  compxE2 e pc (length vs) 
         / I - pcs (compxE2 e' (pc + length (compE2 e)) (Suc (length vs'))),length vs"
    using assms by clarsimp
  have vs: "vs = vs'" using assms by simp
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] bef vs by clarsimp
qed

lemma Jcc_pieces_BinOp2:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e «bop» e')
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "err. Jcc_pieces P1 E C M h1 (v1#vs) ls1 (pc + size (compE2 e)) ics frs sh1
   (I - pcs (compxE2 e pc (length vs'))) h2 ls2 sh2 v' xa e'
   = (True, (v1#vs,ls1,C,M,pc + size (compE2 e),ics)#frs,
       (xp',h',(v'#v1#vs',ls',C0,M',pc' - 1,ics')#frs',sh'),
          (pc1. pc + size (compE2 e)  pc1  pc1 < pc + size (compE2 e) + length (compE2 e') 
               ¬ caught P pc1 h2 xa (compxE2 e' (pc + size (compE2 e)) (Suc (length vs))) 
               (vs'. P  (None,h1,(v1#vs,ls1,C,M,pc + size (compE2 e),ics)#frs,sh1)
                       -jvm→ handle P C M xa h2 (vs'@v1#vs) ls2 pc1 ics frs sh2)))"
proof -
  have bef: "compP compMb2 P1,C0,M'  compxE2 e pc (length vs) 
         / I - pcs (compxE2 e' (pc + length (compE2 e)) (Suc (length vs'))),length vs"
    using assms by clarsimp
  have vs: "vs = vs'" using assms by simp
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e'] bef vs by clarsimp
qed

lemma Jcc_pieces_FAcc:
assumes
 "Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (eF{D})
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "err. Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v' xa e
   = (True, frs0, (xp',h',(v'#vs',ls',C0,M',pc' - 1,ics')#frs',sh'), err)"
proof -
  have pc: "{pc..<pc + length (compE2 e)}  I" using assms by clarsimp
  then show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by clarsimp
qed

lemma Jcc_pieces_LAss:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (i:=e)
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v' xa e
   = (True, frs0, (xp',h',(v'#vs',ls',C0,M',pc' - 2,ics')#frs',sh'),
        (pc1. pc  pc1  pc1 < pc + size(compE2 e) 
               ¬ caught P pc1 h1 xa (compxE2 e pc (size vs)) 
               (vs'. P  (None,h0,frs0,sh0) -jvm→ handle P C M xa h1 (vs'@vs) ls1 pc1 ics frs sh1)))"
proof -
  have pc: "{pc..<pc + length (compE2 e)}  I" using assms by clarsimp
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] pc by clarsimp
qed

lemma Jcc_pieces_FAss1:
assumes
 "Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (eF{D}:=e')
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "err. Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0
 (I - pcs (compxE2 e' (pc + length (compE2 e)) (Suc (length vs')))) h1 ls1 sh1 v' xa e
   = (True, frs0, (xp',h1,(v'#vs',ls1,C0,M',pc' - size (compE2 e') - 2,ics')#frs',sh1), err)"
proof -
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by clarsimp
qed

lemma Jcc_pieces_FAss2:
assumes
 "Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (eF{D}:=e')
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "Jcc_pieces P E C M h1 (v1#vs) ls1 (pc + size (compE2 e)) ics frs sh1
   (I - pcs (compxE2 e pc (length vs'))) h2 ls2 sh2 v' xa e'
   = (True, (v1#vs,ls1,C,M,pc + size (compE2 e),ics)#frs,
       (xp',h',(v'#v1#vs',ls',C0,M',pc' - 2,ics')#frs',sh'),
        (pc1. (pc + size (compE2 e))  pc1  pc1 < pc + size (compE2 e) + size(compE2 e') 
               ¬ caught (compP2 P) pc1 h2 xa (compxE2 e' (pc + size (compE2 e)) (size (v1#vs))) 
               (vs'. (compP2 P)  (None,h1,(v1#vs,ls1,C,M,pc + size (compE2 e),ics)#frs,sh1)
                                   -jvm→ handle (compP2 P) C M xa h2 (vs'@v1#vs) ls2 pc1 ics frs sh2)))"
proof -
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e'] by clarsimp
qed

lemma Jcc_pieces_SFAss:
assumes
 "Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h' ls' sh' v xa (C'sF{D}:=e)
   = (True, frs0, (xp',h',(v#vs',ls',C0,M',pc',ics')#frs',sh'), err)"
shows "err. Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v' xa e
   = (True, frs0, (xp',h1,(v'#vs',ls1,C0,M',pc' - 2,ics')#frs',sh1), err)"
proof -
  have pc: "{pc..<pc + length (compE2 e)}  I" using assms by clarsimp
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] pc by clarsimp
qed

lemma Jcc_pieces_Call1:
assumes
 "Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0 I h3 ls3 sh3 v xa (eM0(es))
   = (True, frs0, (xp',h',(v#vs',ls',C',M',pc',ics')#frs',sh'), err)"
shows "err. Jcc_pieces P E C M h0 vs ls0 pc ics frs sh0
    (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs')))) h1 ls1 sh1 v' xa e
   = (True, frs0,
       (xp',h1,(v'#vs',ls1,C',M',pc' - size (compEs2 es) - 1,ics')#frs',sh1), err)"
proof -
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by clarsimp
qed

lemma Jcc_pieces_clinit:
assumes [simp]: "P  compP2 P1"
  and cond: "Jcc_cond P1 E C M vs pc ics I h sh (C1sclinit([]))"
shows "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C1sclinit([]))
     = (True, create_init_frame P C1 # (vs,ls,C,M,pc,ics)#frs,
          (None, h', (vs,ls,C,M,pc,ics)#frs, sh'(C1(fst(the(sh' C1)),Done))), 
      P  (None,h,create_init_frame P C1 # (vs,ls,C,M,pc,ics)#frs,sh) -jvm→
     (case ics of Called Cs  (None,h',(vs,ls,C,M,pc,Throwing Cs xa)#frs,(sh'(C1  (fst(the(sh' C1)),Error))))))"
using assms by(auto split: init_call_status.splits list.splits bool.splits)

lemma Jcc_pieces_SCall_clinit_body:
assumes [simp]: "P  compP2 P1" and wf: "wf_J1_prog P1"
 and "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h3 ls2 sh3 v xa (C1sclinit([]))
         = (True, frs', rhs', err')"
 and method: "P1  C1 sees clinit,Static: []Void = body in D"
shows "Jcc_pieces P1 [] D clinit h2 [] (replicate (max_vars body) undefined) 0
          No_ics (tl frs') sh2 {..<length (compE2 body)} h3 ls3 sh3 v xa body
           = (True, frs', 
                (None,h3,([v],ls3,D,clinit,size(compE2 body), No_ics)#tl frs',sh3),
                    pc1. 0  pc1  pc1 < size(compE2 body) 
                      ¬ caught P pc1 h3 xa (compxE2 body 0 0) 
                      (vs'. P  (None,h2,frs',sh2) -jvm→ handle P D clinit xa h3 vs' ls3 pc1
                            No_ics (tl frs') sh3))"
proof -
  have M_in_D: "P1  D sees clinit,Static: []Void = body in D"
    using method by(rule sees_method_idemp) 
  hence M_code: "compP2 P1,D,clinit,0  compE2 body @ [Return]"
    and M_xtab: "compP2 P1,D,clinit  compxE2 body 0 0/{..<size(compE2 body)},0"
    by(rule beforeM, rule beforexM)
  have nsub: "¬sub_RI body" by(rule sees_wf1_nsub_RI[OF wf method])
  then show ?thesis using assms nsub_RI_Jcc_pieces M_code M_xtab by clarsimp
qed

lemma Jcc_pieces_Cons:
assumes [simp]: "P  compP2 P1"
 and "P,C,M,pc  compEs2 (e#es)" and "P,C,M  compxEs2 (e#es) pc (size vs)/I,size vs"
 and "{pc..<pc+size(compEs2 (e#es))}  I"
 and "ics = No_ics"
 and "¬sub_RIs (e#es)"
shows "Jcc_pieces P1 E C M h vs ls pc ics frs sh
  (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs)))) h' ls' sh' v xa e
  = (True, (vs, ls, C, M, pc, ics) # frs,
        (None, h', (v#vs, ls', C, M, pc + length (compE2 e), ics) # frs, sh'),
          pc1pc. pc1 < pc + length (compE2 e)  ¬ caught P pc1 h' xa (compxE2 e pc (length vs))
                    (vs'. P  (None, h, (vs, ls, C, M, pc, ics) # frs, sh)
                         -jvm→ handle P C M xa h' (vs'@vs) ls' pc1 ics frs sh'))"
proof -
  show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by auto
qed

lemma Jcc_pieces_InitNone:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
 "Jcc_pieces P1 E C M h vs l pc ics frs (sh(C0  (sblank P C0, Prepared)))
     I h' l' sh' v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
        vs'. P  (None,h,frs',(sh(C0  (sblank P1 C0, Prepared))))
            -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
  have  "Jcc_cond P1 E C M vs pc ics I h sh (INIT C' (C0 # Cs,False)  e)" using assms by simp
  then obtain T where "P1,E,h,sh 1 INIT C' (C0 # Cs,False)  unit : T" by fastforce
  then have "P1,E,h,sh(C0  (sblank P1 C0, Prepared)) 1 INIT C' (C0 # Cs,False)  unit : T"
    by(auto simp: fun_upd_apply)
  then have "Ex (WTrt21 P1 E h (sh(C0  (sblank P1 C0, Prepared))) (INIT C' (C0 # Cs,False)  unit))"
    by(simp only: exI)
  then show ?thesis using assms by clarsimp
qed

lemma Jcc_pieces_InitDP:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
 "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (Cs,True)  e)
    = (True, (calling_to_scalled (hd frs'))#(tl frs'),
         (None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
             vs'. P  (None,h,calling_to_scalled (hd frs')#(tl frs'),sh)
                        -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
  have "Jcc_cond P1 E C M vs pc ics I h sh (INIT C' (C0 # Cs,False)  e)" using assms by simp
  then obtain T where "P1,E,h,sh 1 INIT C' (C0 # Cs,False)  unit : T" by fastforce
  then have "P1,E,h,sh 1 INIT C' (Cs,True)  unit : T"
    by (auto; metis list.sel(2) list.set_sel(2))
  then have wtrt: "Ex (WTrt21 P1 E h sh (INIT C' (Cs,True)  unit))" by(simp only: exI)
  show ?thesis using assms wtrt
  proof(cases Cs)
    case (Cons C1 Cs1)
    then show ?thesis using assms wtrt
      by(case_tac "method P C1 clinit") clarsimp
  qed(clarsimp)
qed

lemma Jcc_pieces_InitError:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
 and err: "sh C0 = Some(sfs,Error)"
shows
 "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa (RI (C0, THROW NoClassDefFoundError);Cs  e)
    = (True, (calling_to_throwing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs'),
         (None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
             vs'. P  (None,h, (calling_to_throwing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs'),sh)
                        -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
  show ?thesis using assms
  proof(cases Cs)
    case (Cons C1 Cs1)
    then show ?thesis using assms
      by(case_tac "method P C1 clinit", case_tac "method P C0 clinit") clarsimp
  qed(clarsimp)
qed

lemma Jcc_pieces_InitObj:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' (sh(C0  (sfs,Processing))) v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
 "Jcc_pieces P1 E C M h vs l pc ics frs (sh(C0  (sfs,Processing))) I h' l' sh'' v xa (INIT C' (C0 # Cs,True)  e)
    = (True, calling_to_called (hd frs')#(tl frs'),
         (None, h', (vs, l, C, M, pc, Called []) # frs, sh''),
             vs'. P  (None,h,calling_to_called (hd frs')#(tl frs'),sh')
                        -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'')"
proof -
  have "Jcc_cond P1 E C M vs pc ics I h sh (INIT C' (C0 # Cs,False)  e)" using assms by simp
  then obtain T where "P1,E,h,sh 1 INIT C' (C0 # Cs,False)  unit : T" by fastforce
  then have "P1,E,h,sh(C0  (sfs,Processing)) 1 INIT C' (C0 # Cs,True)  unit : T"
    using assms by clarsimp (auto simp: fun_upd_apply)
  then have wtrt: "Ex (WTrt21 P1 E h (sh(C0  (sfs,Processing))) (INIT C' (C0 # Cs,True)  unit))"
    by(simp only: exI)
  show ?thesis using assms wtrt by clarsimp
qed

lemma Jcc_pieces_InitNonObj:
assumes [simp]: "P  compP2 P1"
 and "is_class P1 D" and "D  set (C0#Cs)" and "C  set (C0#Cs). P1  C * D"
 and pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' (sh(C0  (sfs,Processing))) v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
 "Jcc_pieces P1 E C M h vs l pc ics frs (sh(C0  (sfs,Processing))) I h' l' sh'' v xa (INIT C' (D # C0 # Cs,False)  e)
    = (True, calling_to_calling (hd frs') D#(tl frs'),
         (None, h', (vs, l, C, M, pc, Called []) # frs, sh''),
             vs'. P  (None,h,calling_to_calling (hd frs') D#(tl frs'),sh')
                        -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'')"
proof -
  have "Jcc_cond P1 E C M vs pc ics I h sh (INIT C' (C0 # Cs,False)  e)" using assms by simp
  then obtain T where "P1,E,h,sh 1 INIT C' (C0 # Cs,False)  unit : T" by fastforce
  then have "P1,E,h,sh(C0  (sfs,Processing)) 1 INIT C' (D # C0 # Cs,False)  unit : T"
    using assms by clarsimp (auto simp: fun_upd_apply)
  then have wtrt: "Ex (WTrt21 P1 E h (sh(C0  (sfs,Processing))) (INIT C' (D # C0 # Cs,False)  unit))"
    by(simp only: exI)
  show ?thesis using assms wtrt by clarsimp
qed

lemma Jcc_pieces_InitRInit:
assumes [simp]: "P  compP2 P1" and wf: "wf_J1_prog P1"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C0 # Cs,True)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
 "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa (RI (C0,C0sclinit([])) ; Cs  e)
    = (True, frs',
         (None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
             vs'. P  (None,h,frs',sh)
                        -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
  have cond: "Jcc_cond P1 E C M vs pc ics I h sh (INIT C' (C0 # Cs,True)  e)" using assms by simp
  then have clinit: "T. P1,E,h,sh 1 C0sclinit([]) : T" using wf
    by clarsimp (auto simp: is_class_def intro: wf1_types_clinit)
  then obtain T where cT: "P1,E,h,sh 1 C0sclinit([]) : T" by blast
  obtain T where "P1,E,h,sh 1 INIT C' (C0 # Cs,True)  unit : T" using cond by fastforce
  then have "P1,E,h,sh 1 RI (C0,C0sclinit([])) ; Cs  unit : T"
    using assms by (auto intro: cT)
  then have wtrt: "Ex (WTrt21 P1 E h sh (RI (C0,C0sclinit([])) ; Cs  unit))"
    by(simp only: exI)
  then show ?thesis using assms by simp
qed

lemma Jcc_pieces_RInit_clinit:
assumes [simp]: "P  compP2 P1" and wf: "wf_J1_prog P1"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h1 l1 sh1 v xa (RI (C0,C0sclinit([]));Cs  e)
    = (True, frs',
         (None, h1, (vs, l, C, M, pc, Called []) # frs, sh1), err)"
shows
 "Jcc_pieces P1 E C M h vs l pc (Called Cs) (tl frs') sh I h' l' sh' v xa (C0sclinit([]))
    = (True, create_init_frame P C0#(vs,l,C,M,pc,Called Cs)#tl frs',
         (None, h', (vs,l,C,M,pc,Called Cs)#tl frs', sh'(C0(fst(the(sh' C0)),Done))),
             P  (None,h,create_init_frame P C0#(vs,l,C,M,pc,Called Cs)#tl frs',sh)
   -jvm→ (None,h',(vs, l, C, M, pc, Throwing Cs xa) # tl frs',sh'(C0  (fst(the(sh' C0)),Error))))"
proof -
  have cond: "Jcc_cond P1 E C M vs pc ics I h sh (RI (C0,C0sclinit([]));Cs  e)" using assms by simp
  then have wtrt: "T. P1,E,h,sh 1 C0sclinit([]) : T" using wf
    by clarsimp (auto simp: is_class_def intro: wf1_types_clinit)
  then show ?thesis using assms by clarsimp
qed

lemma Jcc_pieces_RInit_Init:
assumes [simp]: "P  compP2 P1" and wf: "wf_J1_prog P1"
 and proc: "C'  set Cs. sfs. sh'' C' = (sfs,Processing)"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h1 l1 sh1 v xa (RI (C0,C0sclinit([]));Cs  e)
    = (True, frs',
         (None, h1, (vs, l, C, M, pc, Called []) # frs, sh1), err)"
shows
 "Jcc_pieces P1 E C M h' vs l pc ics frs sh'' I h1 l1 sh1 v xa (INIT (last (C0#Cs)) (Cs,True)  e)
    = (True, (vs, l, C, M, pc, Called Cs) # frs,
         (None, h1, (vs, l, C, M, pc, Called []) # frs, sh1),
             vs'. P  (None,h',(vs, l, C, M, pc, Called Cs) # frs,sh'')
                        -jvm→ handle P C M xa h1 (vs'@vs) l pc ics frs sh1)"
proof -
  have "Jcc_cond P1 E C M vs pc ics I h sh (RI (C0,C0sclinit([]));Cs  e)" using assms by simp
  then have "Ex (WTrt21 P1 E h sh (RI (C0,C0sclinit([])) ; Cs  unit))" by simp
  then obtain T where riwt: "P1,E,h,sh 1 RI (C0,C0sclinit([]));Cs  unit : T" by meson
  then have "P1,E,h',sh'' 1 INIT (last (C0#Cs)) (Cs,True)  unit : T" using proc
  proof(cases Cs) qed(auto)
  then have wtrt: "Ex (WTrt21 P1 E h' sh'' (INIT (last (C0#Cs)) (Cs,True)  unit))" by(simp only: exI)
  show ?thesis using assms wtrt
  proof(cases Cs)
    case (Cons C1 Cs1)
    then show ?thesis using assms wtrt
      by(case_tac "method P C1 clinit") clarsimp
  qed(clarsimp)
qed

lemma Jcc_pieces_RInit_RInit:
assumes [simp]: "P  compP2 P1"
 and "Jcc_pieces P1 E C M h vs l pc ics frs sh I h1 l1 sh1 v xa (RI (C0,e);D#Cs  e')
    = (True, frs', rhs, err)"
 and hd: "hd frs' = (vs1,l1,C1,M1,pc1,ics1)"
shows
 "Jcc_pieces P1 E C M h' vs l pc ics frs sh'' I h1 l1 sh1 v xa (RI (D,Throw xa) ; Cs  e')
    = (True, (vs1, l1, C1, M1, pc1, Throwing (D#Cs) xa) # tl frs',
         (None, h1, (vs, l, C, M, pc, Called []) # frs, sh1),
             vs'. P  (None,h',(vs1, l1, C1, M1, pc1, Throwing (D#Cs) xa) # tl frs',sh'')
                        -jvm→ handle P C M xa h1 (vs'@vs) l pc ics frs sh1)"
using assms by(case_tac "method P D clinit", cases "e = C0sclinit([])") clarsimp+


subsubsection "JVM stepping lemmas"

lemma jvm_Invoke:
assumes [simp]: "P  compP2 P1"
 and "P,C,M,pc  Invoke M' (length Ts)"
 and ha: "h2 a = (Ca, fs)" and method: "P1  Ca sees M', NonStatic :  TsT = body in D"
 and len: "length pvs = length Ts" and "ls2' = Addr a # pvs @ replicate (max_vars body) undefined"
shows "P  (None, h2, (rev pvs @ Addr a # vs, ls2, C, M, pc, No_ics) # frs, sh2) -jvm→
    (None, h2, ([], ls2', D, M', 0, No_ics) # (rev pvs @ Addr a # vs, ls2, C, M, pc, No_ics) # frs, sh2)"
proof -
  have cname: "cname_of h2 (the_Addr ((rev pvs @ Addr a # vs) ! length Ts)) = Ca"
    using ha method len by(auto simp: nth_append)
  have r: "(rev pvs @ Addr a # vs) ! (length Ts) = Addr a" using len by(auto simp: nth_append)
  have exm: "Ts T m D b. P  Ca sees M',b:Ts  T = m in D"
    using sees_method_compP[OF method] by fastforce
  show ?thesis using assms cname r exm by simp
qed

lemma jvm_Invokestatic:
assumes [simp]: "P  compP2 P1"
 and "P,C,M,pc  Invokestatic C' M' (length Ts)"
 and sh: "sh2 D = Some(sfs,Done)"
 and method: "P1  C' sees M', Static :  TsT = body in D"
 and len: "length pvs = length Ts" and "ls2' = pvs @ replicate (max_vars body) undefined"
shows "P  (None, h2, (rev pvs @ vs, ls2, C, M, pc, No_ics) # frs, sh2) -jvm→
    (None, h2, ([], ls2', D, M', 0, No_ics) # (rev pvs @ vs, ls2, C, M, pc, No_ics) # frs, sh2)"
proof -
  have exm: "Ts T m D b. P  C' sees M',b:Ts  T = m in D"
    using sees_method_compP[OF method] by fastforce
  show ?thesis using assms exm by simp
qed

lemma jvm_Invokestatic_Called:
assumes [simp]: "P  compP2 P1"                       
 and "P,C,M,pc  Invokestatic C' M' (length Ts)"
 and sh: "sh2 D = Some(sfs,i)"
 and method: "P1  C' sees M', Static :  TsT = body in D"
 and len: "length pvs = length Ts" and "ls2' = pvs @ replicate (max_vars body) undefined"
shows "P  (None, h2, (rev pvs @ vs, ls2, C, M, pc, Called []) # frs, sh2) -jvm→
    (None, h2, ([], ls2', D, M', 0, No_ics) # (rev pvs @ vs, ls2, C, M, pc, No_ics) # frs, sh2)"
proof -
  have exm: "Ts T m D b. P  C' sees M',b:Ts  T = m in D"
    using sees_method_compP[OF method] by fastforce
  show ?thesis using assms exm by simp
qed

lemma jvm_Return_Init:
"P,D,clinit,0  compE2 body @ [Return]
   P  (None, h, (vs, ls, D, clinit, size(compE2 body), No_ics) # frs, sh)
              -jvm→ (None, h, frs, sh(D(fst(the(sh D)),Done)))"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(cases frs, auto)
done

lemma jvm_InitNone:
 " ics_of f = Calling C Cs;
    sh C = None 
   P  (None,h,f#frs,sh) -jvm→ (None,h,f#frs,sh(C  (sblank P C, Prepared)))"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(cases f) apply(rename_tac ics, case_tac ics, simp_all)
done

lemma jvm_InitDP:
 " ics_of f = Calling C Cs;
    sh C = (sfs,i); i = Done  i = Processing 
   P  (None,h,f#frs,sh) -jvm→ (None,h,(calling_to_scalled f)#frs,sh)"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(cases f)
apply(erule_tac P = "i = Done" in disjE)
 apply simp_all
done

lemma jvm_InitError:
 "sh C = (sfs,Error)
   P  (None,h,(vs,ls,C0,M,pc,Calling C Cs)#frs,sh)
   -jvm→ (None,h,(vs,ls,C0,M,pc,Throwing Cs (addr_of_sys_xcpt NoClassDefFoundError))#frs,sh)"
 by(clarsimp simp: exec_all_def1 intro!: r_into_rtrancl exec_1I)

lemma exec_ErrorThrowing:
 "sh C = (sfs,Error)
   exec (P, (None,h,calling_to_throwing (stk,loc,D,M,pc,Calling C Cs) a#frs,sh))
   = Some (None,h,calling_to_sthrowing (stk,loc,D,M,pc,Calling C Cs) a #frs,sh)"
 by(clarsimp simp: exec_all_def1 fun_upd_idem_iff intro!: r_into_rtrancl exec_1I)

lemma jvm_InitObj:
 " sh C = Some(sfs,Prepared);
     C = Object;
     sh' = sh(C  (sfs,Processing)) 
 P  (None, h, (vs,ls,C0,M,pc,Calling C Cs)#frs, sh) -jvm→
    (None, h, (vs,ls,C0,M,pc,Called (C#Cs))#frs,sh')"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(case_tac "method P C clinit", simp)
done

lemma jvm_InitNonObj:
 " sh C = Some(sfs,Prepared);
     C  Object;
     class P C = Some (D,r);
     sh' = sh(C  (sfs,Processing)) 
 P  (None, h, (vs,ls,C0,M,pc,Calling C Cs)#frs, sh) -jvm→
    (None, h, (vs,ls,C0,M,pc,Calling D (C#Cs))#frs, sh')"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(case_tac "method P C clinit", simp)
done

lemma jvm_RInit_throw:
 "P  (None,h,(vs,l,C,M,pc,Throwing [] xa) # frs,sh)
        -jvm→ handle P C M xa h vs l pc No_ics frs sh"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(simp add: handle_def split: bool.splits)
done

lemma jvm_RInit_throw':
 "P  (None,h,(vs,l,C,M,pc,Throwing [C'] xa) # frs,sh)
        -jvm→ handle P C M xa h vs l pc No_ics frs (sh(C':=Some(fst(the(sh C')), Error)))"
apply(simp add: exec_all_def1)
apply(rule_tac y = "(None,h,(vs,l,C,M,pc,Throwing [] xa) # frs,sh(C':=Some(fst(the(sh C')), Error)))" in rtrancl_trans)
 apply(rule r_into_rtrancl, rule exec_1I)
 apply(simp add: handle_def)
apply(cut_tac jvm_RInit_throw)
apply(simp add: exec_all_def1)
done

lemma jvm_Called:
 "P  (None, h, (vs, l, C, M, pc, Called (C0 # Cs)) # frs, sh) -jvm→
    (None, h, create_init_frame P C0 # (vs, l, C, M, pc, Called Cs) # frs, sh)"
 by(simp add: exec_all_def1 r_into_rtrancl exec_1I)

lemma jvm_Throwing:
 "P  (None, h, (vs, l, C, M, pc, Throwing (C0#Cs) xa') # frs, sh) -jvm→
    (None, h, (vs, l, C, M, pc, Throwing Cs xa') # frs, sh(C0  (fst (the (sh C0)), Error)))"
 by(simp add: exec_all_def1 r_into_rtrancl exec_1I)

subsubsection "Other lemmas for correctness proof"

lemma assumes wf:"wf_prog wf_md P"
 and ex: "class P C = Some a"
shows create_init_frame_wf_eq: "create_init_frame (compP2 P) C = (stk,loc,D,M,pc,ics)  D=C"
using wf_sees_clinit[OF wf ex] by(cases "method P C clinit", auto)

lemma beforex_try:
 " {pc..<pc+size(compE2(try e1 catch(Ci i) e2))}  I;
    P,C,M  compxE2 (try e1 catch(Ci i) e2) pc (size vs) / I,size vs 
    P,C,M  compxE2 e1 pc (size vs) / {pc..<pc + length (compE2 e1)},size vs"
apply(clarsimp simp:beforex_def split:if_split_asm)
apply(rename_tac xt0 xt1) apply(rule_tac x=xt0 in exI)
apply(auto simp: pcs_subset(1))
using atLeastLessThan_iff by blast

― ‹ Evaluation of initialization expressions ›

(* --needs J1 and EConform; version for eval found in Equivalence *)
lemma
shows eval1_init_return: "P 1 e,s  e',s'
   iconf (shp1 s) e
   (Cs b. e = INIT C' (Cs,b)  unit)  (C e0 Cs ei. e = RI(C,e0);Cs@[C']  unit)
      (e0. e = RI(C',e0);Nil  unit)
   (val_of e' = Some v  (sfs i. shp1 s' C' = (sfs,i)  (i = Done  i = Processing)))
    (throw_of e' = Some a  (sfs i. shp1 s' C' = (sfs,Error)))"
and "P 1 es,s [⇒] es',s'  True"
proof(induct rule: eval1_evals1.inducts)
  case (InitFinal1 e s e' s' C b) then show ?case
    by(auto simp: initPD_def dest: eval1_final_same)
next
  case (InitDone1 sh C sfs C' Cs e h l e' s')
  then have "final e'" using eval1_final by simp
  then show ?case
  proof(rule finalE)
    fix v assume e': "e' = Val v" then show ?thesis using InitDone1 initPD_def
    proof(cases Cs) qed(auto)
  next
    fix a assume e': "e' = throw a" then show ?thesis using InitDone1 initPD_def
    proof(cases Cs) qed(auto)
  qed
next
  case (InitProcessing1 sh C sfs C' Cs e h l e' s')
  then have "final e'" using eval1_final by simp
  then show ?case
  proof(rule finalE)
    fix v assume e': "e' = Val v" then show ?thesis using InitProcessing1 initPD_def
    proof(cases Cs) qed(auto)
  next
    fix a assume e': "e' = throw a" then show ?thesis using InitProcessing1 initPD_def
    proof(cases Cs) qed(auto)
  qed
next
  case (InitError1 sh C sfs Cs e h l e' s' C') show ?case
  proof(cases Cs)
    case Nil then show ?thesis using InitError1 by simp
  next
    case (Cons C2 list)
    then have "final e'" using InitError1 eval1_final by simp
    then show ?thesis
    proof(rule finalE)
      fix v assume e': "e' = Val v" show ?thesis
        using InitError1.hyps(2) e' rinit1_throwE by blast
    next
      fix a assume e': "e' = throw a"
      then show ?thesis using Cons InitError1 cons_to_append[of list] by clarsimp
    qed
  qed
next
  case (InitRInit1 C Cs h l sh e' s' C') show ?case
  proof(cases Cs)
    case Nil then show ?thesis using InitRInit1 by simp
  next
    case (Cons C' list) then show ?thesis
      using InitRInit1 Cons cons_to_append[of list] by clarsimp
  qed
next
  case (RInit1 e s v h' l' sh' C sfs i sh'' C' Cs e' e1 s1)
  then have final: "final e1" using eval1_final by simp
  then show ?case
  proof(cases Cs)
    case Nil show ?thesis using final
    proof(rule finalE)
      fix v assume e': "e1 = Val v" show ?thesis
      using RInit1 Nil by(clarsimp, meson fun_upd_same initPD_def)
    next
      fix a assume e': "e1 = throw a" show ?thesis
      using RInit1 Nil by(clarsimp, meson fun_upd_same initPD_def)
    qed
  next
    case (Cons a list) show ?thesis using final
    proof(rule finalE)
      fix v assume e': "e1 = Val v" then show ?thesis
      using RInit1 Cons by(clarsimp, metis last.simps last_appendR list.distinct(1))
    next
      fix a assume e': "e1 = throw a" then show ?thesis
      using RInit1 Cons by(clarsimp, metis last.simps last_appendR list.distinct(1))
    qed
  qed
next
  case (RInitInitFail1 e s a h' l' sh' C sfs i sh'' D Cs e' e1 s1)
  then have final: "final e1" using eval1_final by simp
  then show ?case
  proof(rule finalE)
    fix v assume e': "e1 = Val v" then show ?thesis
    using RInitInitFail1 by(clarsimp, meson exp.distinct(101) rinit1_throwE)
  next
    fix a' assume e': "e1 = Throw a'"
    then have "iconf (sh'(C  (sfs, Error))) a"
      using RInitInitFail1.hyps(1) eval1_final by fastforce
    then show ?thesis using RInitInitFail1 e'
      by(clarsimp, meson Cons_eq_append_conv list.inject)
  qed
qed(auto simp: fun_upd_same)

lemma init1_Val_PD: "P 1 INIT C' (Cs,b)  unit,s  Val v,s'
   iconf (shp1 s) (INIT C' (Cs,b)  unit)
   sfs i. shp1 s' C' = (sfs,i)  (i = Done  i = Processing)"
 by(drule_tac v = v in eval1_init_return, simp+)

lemma init1_throw_PD: "P 1 INIT C' (Cs,b)  unit,s  throw a,s'
   iconf (shp1 s) (INIT C' (Cs,b)  unit)
   sfs i. shp1 s' C' = (sfs,Error)"
 by(drule_tac a = a in eval1_init_return, simp+)

lemma rinit1_Val_PD: "P 1 RI(C,e0);Cs  unit,s  Val v,s'
   iconf (shp1 s) (RI(C,e0);Cs  unit)  last(C#Cs) = C'
   sfs i. shp1 s' C' = (sfs,i)  (i = Done  i = Processing)"
apply(drule_tac C' = C' and v = v in eval1_init_return, simp_all)
apply (metis append_butlast_last_id)
done

lemma rinit1_throw_PD: "P 1 RI(C,e0);Cs  unit,s  throw a,s'
   iconf (shp1 s) (RI(C,e0);Cs  unit)  last(C#Cs) = C'
   sfs i. shp1 s' C' = (sfs,Error)"
apply(drule_tac C' = C' and a = a in eval1_init_return, simp_all)
apply (metis append_butlast_last_id)
done

subsubsection "The proof"

lemma fixes P1 defines [simp]: "P  compP2 P1"
assumes wf: "wf_J1_prog P1"
shows Jcc: "P1 1 e,(h0,ls0,sh0)  ef,(h1,ls1,sh1) 
  (E C M pc ics v xa vs frs I.
      Jcc_cond P1 E C M vs pc ics I h0 sh0 e  
     (ef = Val v 
         P  (None,h0,Jcc_frames P C M vs ls0 pc ics frs e,sh0)
                -jvm→ Jcc_rhs P1 E C M vs ls0 pc ics frs h1 ls1 sh1 v e)
     
     (ef = Throw xa  Jcc_err P C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 xa e)
  )"
(*<*)
  (is "_  (E C M pc ics v xa vs frs I.
                  PROP ?P e h0 ls0 sh0 ef h1 ls1 sh1 E C M pc ics v xa vs frs I)")
(*>*)
and "P1 1 es,(h0,ls0,sh0) [⇒] fs,(h1,ls1,sh1) 
    (C M pc ics ws xa es' vs frs I.
       P,C,M,pc  compEs2 es; P,C,M  compxEs2 es pc (size vs)/I,size vs;
       {pc..<pc+size(compEs2 es)}  I; ics = No_ics;
       ¬sub_RIs es  
      (fs = map Val ws 
       P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
             (None,h1,(rev ws @ vs,ls1,C,M,pc+size(compEs2 es),ics)#frs,sh1))
      
      (fs = map Val ws @ Throw xa # es' 
       (pc1. pc  pc1  pc1 < pc + size(compEs2 es) 
                ¬ caught P pc1 h1 xa (compxEs2 es pc (size vs)) 
                (vs'. P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)
                                     -jvm→ handle P C M xa h1 (vs'@vs) ls1 pc1 ics frs sh1))))"
(*<*)
  (is "_  (C M pc ics ws xa es' vs frs I.
                  PROP ?Ps es h0 ls0 sh0 fs h1 ls1 sh1 C M pc ics ws xa es' vs frs I)")
proof (induct rule:eval1_evals1_inducts)
  case New1 thus ?case by auto
next
  case (NewFail1 sh C' sfs h ls)
  let ?xa = "addr_of_sys_xcpt OutOfMemory"
  have "P  (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ handle P C M ?xa h vs ls pc ics frs sh"
    using NewFail1 by(clarsimp simp: handle_def)
  then show ?case by(auto intro!: exI[where x="[]"])
next
  case (NewInit1 sh C' h ls v' h' ls' sh' a FDTs h'')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (new C')
    = (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE2 (new C')),ics)#frs,sh'), err)"
    using NewInit1.prems(1) by clarsimp
  have "Ex (WTrt21 P1 E h sh (INIT C' ([C'],False)  unit))"
    using has_fields_is_class[OF NewInit1.hyps(5)] by auto
  then obtain err' where pcs':
    "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v' xa (INIT C' ([C'],False)  unit)
    = (True, (vs,ls,C,M,pc,Calling C' []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'), err')"
    using NewInit1.prems(1) by auto
  have IH: "PROP ?P (INIT C' ([C'],False)  unit) h ls sh (Val v')
             h' ls' sh' E C M pc ics v' xa vs frs I" by fact
  have ls: "ls = ls'" by(rule init1_same_loc[OF NewInit1.hyps(2)])
  obtain sfs i where sh': "sh' C' = Some(sfs,i)"
    using init1_Val_PD[OF NewInit1.hyps(2)] by clarsimp
  have "P  (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling C' [])#frs,sh)"
  proof(cases "sh C'")
    case None then show ?thesis using NewInit1.prems by(cases ics) auto
  next
    case (Some a)
    then obtain sfs i where "a = (sfs,i)" by(cases a)
    then show ?thesis using NewInit1.hyps(1) NewInit1.prems Some
      by(cases ics; case_tac i) auto
  qed
  also have "P   -jvm→ (None, h', (vs, ls, C, M, pc, Called []) # frs, sh')"
    using IH pcs' by auto
  also have "P   -jvm→ (None, h'', (Addr a#vs, ls, C, M, Suc pc, ics) # frs, sh')"
    using NewInit1.hyps(1,2,4-6) NewInit1.prems sh' by(cases ics) auto
  finally show ?case using pcs ls by clarsimp
next
  case (NewInitOOM1 sh C' h ls v' h' ls' sh')
  let ?xa = "addr_of_sys_xcpt OutOfMemory"
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (new C')
    = (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE2 (new C')),ics)#frs,sh'), err)"
    using NewInitOOM1.prems(1) by clarsimp
  have "Ex (WTrt21 P1 E h sh (INIT C' ([C'],False)  unit))" using NewInitOOM1.hyps(5) by auto
  then obtain err' where pcs':
    "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v' xa (INIT C' ([C'],False)  unit)
    = (True, (vs,ls,C,M,pc,Calling C' []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'), err')"
    using NewInitOOM1.prems(1) by auto
  have IH: "PROP ?P (INIT C' ([C'],False)  unit) h ls sh (Val v')
             h' ls' sh' E C M pc ics v' xa vs frs I" by fact
  have ls: "ls = ls'" by(rule init1_same_loc[OF NewInitOOM1.hyps(2)])
  have "iconf (shp1 (h, ls, sh)) (INIT C' ([C'],False)  unit)" by simp
  then obtain sfs i where sh': "sh' C' = Some(sfs,i)"
    using init1_Val_PD[OF NewInitOOM1.hyps(2)] by clarsimp
  have "P  (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling C' [])#frs,sh)"
  proof(cases "sh C'")
    case None then show ?thesis using NewInitOOM1.prems by(cases ics) auto
  next
    case (Some a)
    then obtain sfs i where "a = (sfs,i)" by(cases a)
    then show ?thesis using NewInitOOM1.hyps(1) NewInitOOM1.prems Some
      by(cases ics; case_tac i) auto
  qed
  also have "P   -jvm→ (None, h', (vs, ls, C, M, pc, Called []) # frs, sh')"
    using IH pcs' by auto
  also have "P   -jvm→ handle P C M ?xa h' vs ls pc ics frs sh'"
    using NewInitOOM1.hyps(1,2,4,5) NewInitOOM1.prems sh' by(auto simp: handle_def)
  finally show ?case using pcs ls by(simp, metis (no_types) append_Nil le_refl lessI)
next
  case (NewInitThrow1 sh C' h ls a h' ls' sh')
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (new C')
    = (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE2 (new C')),ics)#frs,sh'), err)"
    using NewInitThrow1.prems(1) by clarsimp
  obtain a' where throw: "throw a = Throw a'" using eval1_final[OF NewInitThrow1.hyps(2)] by clarsimp
  have "Ex (WTrt21 P1 E h sh (INIT C' ([C'],False)  unit))" using NewInitThrow1.hyps(4) by auto
  then obtain vs' where pcs':
    "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v a' (INIT C' ([C'],False)  unit)
    = (True, (vs,ls,C,M,pc,Calling C' []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'),
        P  (None,h,(vs,ls,C,M,pc,Calling C' []) # frs,sh)
               -jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh')"
    using NewInitThrow1.prems(1) by simp blast
  have IH: "PROP ?P (INIT C' ([C'],False)  unit) h ls sh (throw a)
             h' ls' sh' E C M pc ics v a' vs frs I" by fact
  have ls: "ls = ls'" by(rule init1_same_loc[OF NewInitThrow1.hyps(2)])
  then have "P  (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling C' []) # frs,sh)"
  proof(cases "sh C'")
    case None then show ?thesis using NewInitThrow1.prems by(cases ics) auto
  next
    case (Some a)
    then obtain sfs i where "a = (sfs,i)" by(cases a)
    then show ?thesis using NewInitThrow1.hyps(1) NewInitThrow1.prems Some
      by(cases ics; case_tac i) auto
  qed
  also have "P   -jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh'" using IH pcs' throw by auto
  finally show ?case using throw ls by auto
next
  case (Cast1 e h0 ls0 sh0 a h1 ls1 sh1 D fs C')
  let ?pc = "pc + length(compE2 e)"
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (Cast C' e)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (Cast C' e)),ics)#frs,sh1), err)"
    using Cast1.prems(1) by auto
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs I" by fact
  then have "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
             (None,h1,(Addr a#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using Jcc_pieces_Cast[OF assms(1) pcs, of "Addr a"] Cast1.prems pcs by auto
  also have "P   -jvm→ (None,h1,(Addr a#vs,ls1,C,M,?pc+1,ics)#frs,sh1)"
    using Cast1 by (auto simp add:cast_ok_def)
  finally show ?case by auto
next
  case (CastNull1 e h0 ls0 sh0 h1 ls1 sh1 C')
  let ?pc = "pc + length(compE2 e)"
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (Cast C' e)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (Cast C' e)),ics)#frs,sh1), err)"
    using CastNull1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 null h1 ls1 sh1 E C M pc ics Null xa vs frs I" by fact
  then have "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
             (None,h1,(Null#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using Jcc_pieces_Cast[OF assms(1) pcs, of Null] CastNull1.prems pcs by auto
  also have "P   -jvm→ (None,h1,(Null#vs,ls1,C,M,?pc+1,ics)#frs,sh1)"
    using CastNull1 by (auto simp add:cast_ok_def)
  finally show ?case by auto
next
  case (CastFail1 e h0 ls0 sh0 a h1 ls1 sh1 D fs C')
  let ?pc = "pc + length(compE2 e)"
  let ?xa = "addr_of_sys_xcpt ClassCast"
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (Cast C' e)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (Cast C' e)),ics)#frs,sh1), err)"
    using CastFail1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs I" by fact
  then have "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
             (None,h1,(Addr a#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using Jcc_pieces_Cast[OF assms(1) pcs, of "Addr a"] CastFail1.prems pcs by auto
  also have "P   -jvm→ handle P C M ?xa h1 (Addr a#vs) ls1 ?pc ics frs sh1"
    using CastFail1 by (auto simp add:handle_def cast_ok_def)
  finally have exec: "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→ ".
  show ?case (is "?N  (?eq  ?err)")
  proof
    show ?N by simp
  next
    { assume ?eq
      then have ?err using exec by (auto intro!: exI[where x="?pc"] exI[where x="[Addr a]"])
    }
    thus "?eq  ?err" by simp
  qed
next
  case (CastThrow1 e h0 ls0 sh0 e' h1 ls1 sh1 C')
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (Cast C' e)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (Cast C' e)),ics)#frs,sh1), err)"
    using CastThrow1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (throw e') h1 ls1 sh1 E C M pc ics v xa vs frs I" by fact
  show ?case using IH Jcc_pieces_Cast[OF assms(1) pcs, of v] CastThrow1.prems pcs less_SucI
   by(simp, blast)
next
  case Val1 thus ?case by auto
next
  case Var1 thus ?case by auto
next
  case (BinOp1 e1 h0 ls0 sh0 v1 h1 ls1 sh1 e2 v2 h2 ls2 sh2 bop w)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e1 «bop» e2)
    = (True, frs', (None,h2,(v#vs,ls2,C,M,pc+size(compE2 (e1 «bop» e2)),ics)#frs,sh2), err)"
    using BinOp1.prems(1) by clarsimp
  let ?pc1 = "pc + length(compE2 e1)"
  let ?pc2 = "?pc1 + length(compE2 e2)"
  have IH1: "PROP ?P e1 h0 ls0 sh0 (Val v1) h1 ls1 sh1 E C M pc ics v1 xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 (Val v2) h2 ls2 sh2 E C M ?pc1 ics v2 xa (v1#vs) frs
                     (I - pcs(compxE2 e1 pc (size vs)))" by fact
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(v1#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using IH1 Jcc_pieces_BinOp1[OF pcs, of h1 ls1 sh1 v1] by simp
  also have "P   -jvm→ (None,h2,(v2#v1#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
    using IH2 Jcc_pieces_BinOp2[OF assms(1) pcs, of h1 v1 ls1 sh1 v2] by (simp add: add.assoc)
  also have "P   -jvm→ (None,h2,(w#vs,ls2,C,M,?pc2+1,ics)#frs,sh2)"
    using BinOp1 by(cases bop) auto
  finally show ?case using pcs by (auto split: bop.splits simp:add.assoc)
next
  case (BinOpThrow11 e1 h0 ls0 sh0 e h1 ls1 sh1 bop e2)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (e1 «bop» e2)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (e1 «bop» e2)),ics)#frs,sh1), err)"
    using BinOpThrow11.prems(1) by clarsimp
  have IH1: "PROP ?P e1 h0 ls0 sh0 (throw e) h1 ls1 sh1 E C M pc ics v xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  show ?case using IH1 Jcc_pieces_BinOp1[OF pcs, of h1 ls1 sh1 v] BinOpThrow11.prems nsub_RI_Jcc_pieces
    by auto
next
  case (BinOpThrow21 e1 h0 ls0 sh0 v1 h1 ls1 sh1 e2 e h2 ls2 sh2 bop)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e1 «bop» e2)
    = (True, frs', (None,h2,(v#vs,ls2,C,M,pc+size(compE2 (e1 «bop» e2)),ics)#frs,sh2), err)"
    using BinOpThrow21.prems(1) by clarsimp
  let ?pc = "pc + length(compE2 e1)"
  have IH1: "PROP ?P e1 h0 ls0 sh0 (Val v1) h1 ls1 sh1 E C M pc ics v1 xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 (throw e) h2 ls2 sh2 E C M ?pc ics v xa (v1#vs) frs
                     (I - pcs(compxE2 e1 pc (size vs)))" by fact
  let 1 = "(None,h1,(v1#vs,ls1,C,M,?pc,ics)#frs,sh1)"
  have 1: "P  (None,h0,frs',sh0) -jvm→ 1"
    using IH1 Jcc_pieces_BinOp1[OF pcs, of h1 ls1 sh1 v1] by simp
  have "(throw e = Val v   P  (None, h0, Jcc_frames P C M vs ls0 pc ics frs (e1 «bop» e2), sh0) -jvm→
     Jcc_rhs P1 E C M vs ls0 pc ics frs h2 ls2 sh2 v (e1 «bop» e2))
    (throw e = Throw xa  (pc1. pc  pc1  pc1 < pc + size(compE2 (e1 «bop» e2)) 
               ¬ caught P pc1 h2 xa (compxE2 (e1 «bop» e2) pc (size vs)) 
               (vs'. P  (None,h0,frs',sh0) -jvm→ handle P C M xa h2 (vs'@vs) ls2 pc1 ics frs sh2)))"
   (is "?N  (?eq  (pc2. ?H pc2))")
  proof
    show ?N by simp
  next
    { assume ?eq
      then obtain pc2 vs' where
        pc2: "?pc  pc2  pc2 < ?pc + size(compE2 e2) 
              ¬ caught P pc2 h2 xa (compxE2 e2 ?pc (size vs + 1))" and
        2: "P  1 -jvm→ handle P C M xa h2 (vs'@v1#vs) ls2 pc2 ics frs sh2"
        using IH2 Jcc_pieces_BinOp2[OF assms(1) pcs, of h1 v1 ls1 sh1 v] BinOpThrow21.prems by clarsimp
      then have "?H pc2" using jvm_trans[OF 1 2] by(auto intro!: exI[where x="vs'@[v1]"])
      hence "pc2. ?H pc2" by iprover
    }
    thus "?eq  (pc2. ?H pc2)" by iprover
  qed
  then show ?case using pcs by simp blast
next
  case (FAcc1 e h0 ls0 sh0 a h1 ls1 sh1 C' fs F T D w)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (eF{D})
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (eF{D})),ics)#frs,sh1), err)"
    using FAcc1.prems(1) by clarsimp
  have "P1  D sees F,NonStatic:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAcc1.hyps(4)]])
  then have field: "field P D F = (D,NonStatic,T)" by simp
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs I" by fact
  let ?pc = "pc + length(compE2 e)"
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Addr a#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_FAcc[OF pcs, of "Addr a"] pcs by simp
  also have "P   -jvm→ (None,h1,(w#vs,ls1,C,M,?pc+1,ics)#frs,sh1)"
    using FAcc1 field by auto
  finally have "P  (None, h0, frs', sh0) -jvm→ (None,h1,(w#vs,ls1,C,M,?pc+1,ics)#frs,sh1)"
    by auto
  then show ?case using pcs by auto
next
  case (FAccNull1 e h0 ls0 sh0 h1 ls1 sh1 F D)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (eF{D})
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (eF{D})),ics)#frs,sh1), err)"
    using FAccNull1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 null h1 ls1 sh1 E C M pc ics Null xa vs frs I" by fact
  let ?pc = "pc + length(compE2 e)"
  let ?xa = "addr_of_sys_xcpt NullPointer"
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Null#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_FAcc[OF pcs, of Null] by simp
  also have "P   -jvm→ handle P C M ?xa h1 (Null#vs) ls1 ?pc ics frs sh1"
    using FAccNull1.prems
    by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[Null]"])
next
  case (FAccThrow1 e h0 ls0 sh0 e' h1 ls1 sh1 F D)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (eF{D})
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (eF{D})),ics)#frs,sh1), err)"
    using FAccThrow1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (throw e') h1 ls1 sh1 E C M pc ics v xa vs frs I" by fact
  show ?case using IH Jcc_pieces_FAcc[OF pcs, of v] FAccThrow1.prems nsub_RI_Jcc_pieces
    less_Suc_eq by auto
next
  case (FAccNone1 e h0 ls0 sh0 a h1 ls1 sh1 C fs F D)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (eF{D})
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (eF{D})),ics)#frs,sh1), err)"
    using FAccNone1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs I" by fact
  let ?pc = "pc + length(compE2 e)"
  let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Addr a#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_FAcc[OF pcs, of "Addr a"] by simp
  also have "P   -jvm→ handle P C M ?xa h1 (Addr a#vs) ls1 ?pc ics frs sh1"
    using FAccNone1
    by(cases ics; clarsimp simp:split_beta handle_def simp del: split_paired_Ex)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[Addr a]"])
next
  case (FAccStatic1 e h0 ls0 sh0 a h1 ls1 sh1 C' fs F T D)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (eF{D})
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (eF{D})),ics)#frs,sh1), err)"
    using FAccStatic1.prems(1) by clarsimp
  have "P1  D sees F,Static:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAccStatic1.hyps(4)]])
  then have field: "field P D F = (D,Static,T)" by simp
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs I" by fact
  let ?pc = "pc + length(compE2 e)"
  let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Addr a#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_FAcc[OF pcs, of "Addr a"] by simp
  also have "P   -jvm→ handle P C M ?xa h1 (Addr a#vs) ls1 ?pc ics frs sh1"
    using FAccStatic1 field by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[Addr a]"])
next
  case (SFAcc1 C' F t D sh sfs v' h ls)
  have has: "P1  D has F,Static:t in D" by(rule has_field_idemp[OF SFAcc1.hyps(1)])
  have "P1  D sees F,Static:t in D" by(rule has_field_sees[OF has])
  then have field: "field P D F = (D,Static,t)" by simp
  then have "P  (None,h,Jcc_frames P C M vs ls pc ics frs (C'sF{D}),sh) -jvm→
             (None,h,(v'#vs,ls,C,M,Suc pc,ics)#frs,sh)"
    using SFAcc1 has by(cases ics) auto
  then show ?case by clarsimp
next
  case (SFAccInit1 C' F t D sh h ls v' h' ls' sh' sfs i v'')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C'sF{D})
    = (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE2 (C'sF{D})),ics)#frs,sh'), err)"
    using SFAccInit1.prems(1) by clarsimp
  have "Ex (WTrt21 P1 E h sh (INIT D ([D],False)  unit))"
    using has_field_is_class'[OF SFAccInit1.hyps(1)] by auto
  then obtain err' where pcs':
    "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v' xa (INIT D ([D],False)  unit)
    = (True, (vs,ls,C,M,pc,Calling D []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'), err')"
    using SFAccInit1.prems(1) by auto
  have IH: "PROP ?P (INIT D ([D],False)  unit) h ls sh (Val v')
             h' ls' sh' E C M pc ics v' xa vs frs I" by fact
  have ls: "ls = ls'" by(rule init1_same_loc[OF SFAccInit1.hyps(3)])
  have has: "P1  D has F,Static:t in D" by(rule has_field_idemp[OF SFAccInit1.hyps(1)])
  have "P1  D sees F,Static:t in D" by(rule has_field_sees[OF has])
  then have field: "field P D F = (D,Static,t)" by simp
  have "P  (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling D [])#frs,sh)"
  proof(cases "sh D")
    case None then show ?thesis using SFAccInit1.hyps(1,2,5,6) SFAccInit1.prems field
      by(cases ics) auto
  next
    case (Some a)
    then obtain sfs i where "a = (sfs,i)" by(cases a)
    then show ?thesis using SFAccInit1.hyps(1,2,5,6) SFAccInit1.prems field Some
      by(cases ics; case_tac i) auto
  qed
  also have "P  ... -jvm→ (None, h', (vs, ls, C, M, pc, Called []) # frs, sh')"
    using IH pcs' by auto
  also have "P  ... -jvm→ (None, h', (v''#vs, ls, C, M, Suc pc, ics) # frs, sh')"
    using SFAccInit1.hyps(1,2,5,6) SFAccInit1.prems has field by(cases ics) auto
  finally show ?case using pcs ls by clarsimp
next
  case (SFAccInitThrow1 C' F t D sh h ls a h' ls' sh')
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C'sF{D})
    = (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE2 (C'sF{D})),ics)#frs,sh'), err)"
    using SFAccInitThrow1.prems(1) by clarsimp
  obtain a' where throw: "throw a = Throw a'" using eval1_final[OF SFAccInitThrow1.hyps(3)] by clarsimp
  have "Ex (WTrt21 P1 E h sh (INIT D ([D],False)  unit))"
    using has_field_is_class'[OF SFAccInitThrow1.hyps(1)] by auto
  then obtain vs' where pcs':
    "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v a' (INIT D ([D],False)  unit)
    = (True, (vs,ls,C,M,pc,Calling D []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'),
        P  (None,h,(vs,ls,C,M,pc,Calling D []) # frs,sh)
               -jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh')"
    using SFAccInitThrow1.prems(1) by simp blast
  have IH: "PROP ?P (INIT D ([D],False)  unit) h ls sh (throw a)
             h' ls' sh' E C M pc ics v a' vs frs I" by fact
  have ls: "ls = ls'" by(rule init1_same_loc[OF SFAccInitThrow1.hyps(3)])
  have has: "P1  D has F,Static:t in D" by(rule has_field_idemp[OF SFAccInitThrow1.hyps(1)])
  have "P1  D sees F,Static:t in D" by(rule has_field_sees[OF has])
  then have field: "field P D F = (D,Static,t)" by simp
  then have "P  (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling D []) # frs,sh)"
  proof(cases "sh D")
    case None then show ?thesis using SFAccInitThrow1.hyps(1,2) SFAccInitThrow1.prems field
      by(cases ics) auto
  next
    case (Some a)
    then obtain sfs i where "a = (sfs,i)" by(cases a)
    then show ?thesis using SFAccInitThrow1.hyps(1,2) SFAccInitThrow1.prems field Some
      by(cases ics; case_tac i) auto
  qed
  also have "P   -jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh'"
    using IH pcs' throw by auto
  finally show ?case using throw ls by auto
next
  case (SFAccNone1 C' F D h1 ls1 sh1)
  then obtain frs' err where pcs:
   "Jcc_pieces P1 E C M h1 vs ls1 pc ics frs sh1 I h1 ls1 sh1 v xa (C'sF{D})
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (C'sF{D})),ics)#frs,sh1), err)"
    by clarsimp
  let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
  have "P  (None,h1,frs',sh1) -jvm→ handle P C M ?xa h1 vs ls1 pc ics frs sh1"
    using SFAccNone1 pcs
    by(cases ics; clarsimp simp:split_beta handle_def simp del: split_paired_Ex)
  then show ?case using pcs by(auto intro!: exI[where x = pc] exI[where x="[]"])
next
  case (SFAccNonStatic1 C' F t D h1 ls1 sh1)
  let ?frs' = "(vs, ls1, C, M, pc, ics) # frs"
  let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
  have "P1  D sees F,NonStatic:t in D"
    by(rule has_field_sees[OF has_field_idemp[OF SFAccNonStatic1.hyps(1)]])
  then have field: "field P D F = (D,NonStatic,t)" by simp
  have "P  (None,h1,?frs',sh1) -jvm→ handle P C M ?xa h1 vs ls1 pc ics frs sh1"
    using SFAccNonStatic1
    proof(cases ics)
      case No_ics
      then show ?thesis using SFAccNonStatic1 field
       by (auto simp:split_beta handle_def simp del: split_paired_Ex)
    qed(simp_all)
  then show ?case by (auto intro!: exI[where x = pc] exI[where x="[]"])
next
  case (LAss1 e h0 ls0 sh0 w h1 ls1 sh1 i ls2)
  let ?pc = "pc + length(compE2 e)"
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (i:=e)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (i:=e)),ics)#frs,sh1), err)"
    using LAss1.prems(1) by auto
  have IH: "PROP ?P e h0 ls0 sh0 (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs I" by fact
  then have "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
             (None,h1,(w#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using Jcc_pieces_LAss[OF assms(1) pcs, of w] LAss1.prems pcs by auto
  also have "P   -jvm→ (None,h1,(Unit#vs,ls2,C,M,?pc+2,ics)#frs,sh1)"
    using LAss1 by (auto simp add:cast_ok_def)
  finally show ?case by auto
next
  case (LAssThrow1 e h0 ls0 sh0 w h1 ls1 sh1 i)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (i:=e)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (i:=e)),ics)#frs,sh1), err)"
    using LAssThrow1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (throw w) h1 ls1 sh1 E C M pc ics v xa vs frs I" by fact
  show ?case using IH Jcc_pieces_LAss[OF assms(1) pcs, of v] LAssThrow1.prems pcs less_SucI
    by(simp, blast)
next
  case (FAss1 e1 h0 ls0 sh0 a h1 ls1 sh1 e2 w h2 ls2 sh2 C' fs F T D fs' h2')
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e1F{D} := e2)
    = (True, frs', (None,h2,(v#vs,ls2,C,M,pc+size(compE2 (e1F{D} := e2)),ics)#frs,sh2), err)"
    using FAss1.prems(1) by clarsimp
  have "P1  D sees F,NonStatic:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAss1.hyps(6)]])
  then have field: "field P D F = (D,NonStatic,T)" by simp
  let ?pc1 = "pc + length(compE2 e1)"
  let ?pc2 = "?pc1 + length(compE2 e2)"
  have IH1: "PROP ?P e1 h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 (Val w) h2 ls2 sh2 E C M ?pc1 ics w xa (Addr a#vs) frs
                     (I - pcs(compxE2 e1 pc (size vs)))" by fact
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Addr a#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using IH1 Jcc_pieces_FAss1[OF pcs, of h1 ls1 sh1 "Addr a"] by simp
  also have "P   -jvm→ (None,h2,(w#Addr a#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
    using IH2 Jcc_pieces_FAss2[OF pcs, of h1 "Addr a" ls1 sh1 w] by (simp add: add.assoc)
  also have "P   -jvm→ (None,h2',(Unit#vs,ls2,C,M,?pc2+2,ics)#frs,sh2)"
    using FAss1 field by auto
  finally show ?case using pcs by (auto simp:add.assoc)
next
  case (FAssNull1 e1 h0 ls0 sh0 h1 ls1 sh1 e2 w h2 ls2 sh2 F D)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e1F{D} := e2)
    = (True, frs', (None,h2,(v#vs,ls2,C,M,pc+size(compE2 (e1F{D} := e2)),ics)#frs,sh2), err)"
    using FAssNull1.prems(1) by clarsimp
  let ?pc1 = "pc + length(compE2 e1)"
  let ?pc2 = "?pc1 + length(compE2 e2)"
  let ?xa = "addr_of_sys_xcpt NullPointer"
  have IH1: "PROP ?P e1 h0 ls0 sh0 null h1 ls1 sh1 E C M pc ics Null xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 (Val w) h2 ls2 sh2 E C M ?pc1 ics w xa (Null#vs) frs
                     (I - pcs(compxE2 e1 pc (size vs)))" by fact
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Null#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using IH1 Jcc_pieces_FAss1[OF pcs, of h1 ls1 sh1 Null] by simp
  also have "P   -jvm→ (None,h2,(w#Null#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
    using IH2 Jcc_pieces_FAss2[OF pcs, of h1 Null ls1 sh1 w] by (simp add: add.assoc)
  also have "P   -jvm→ handle P C M ?xa h2 (w#Null#vs) ls2 ?pc2 ics frs sh2"
    using FAssNull1 by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc2] exI[where x="w#[Null]"])
next
  case (FAssThrow21 e1 h0 ls0 sh0 w h1 ls1 sh1 e2 e' h2 ls2 sh2 F D)
  let ?frs' = "(vs, ls0, C, M, pc, ics) # frs"
  obtain err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e1F{D} := e2)
    = (True, ?frs', (None,h2,(v#vs,ls2,C,M,pc+size(compE2 (e1F{D} := e2)),ics)#frs,sh2), err)"
    using FAssThrow21.prems(1) by clarsimp
  let ?pc1 = "pc + length(compE2 e1)"
  let 1 = "(None,h1,(w#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
  have IH1: "PROP ?P e1 h0 ls0 sh0 (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 (throw e') h2 ls2 sh2 E C M ?pc1 ics v xa (w#vs) frs
                     (I - pcs(compxE2 e1 pc (size vs)))" by fact
  have 1: "P  (None,h0,?frs',sh0) -jvm→ 1"
    using IH1 Jcc_pieces_FAss1[OF pcs, of h1 ls1 sh1 w] by simp
  show ?case (is "?N  (?eq  ?err)")
  proof
    show ?N by simp
  next
    { assume ?eq
      moreover
      have "PROP ?P e2 h1 ls1 sh1 (throw e') h2 ls2 sh2 E C M ?pc1 ics v xa (w#vs) frs
                    (I - pcs (compxE2 e1 pc (length vs)))" by fact
      ultimately obtain pc2 vs' where
        pc2: "?pc1  pc2  pc2 < ?pc1 + size(compE2 e2) 
              ¬ caught P pc2 h2 xa (compxE2 e2 ?pc1 (size vs + 1))" and
        2: "P  1 -jvm→ handle P C M xa h2 (vs'@w#vs) ls2 pc2 ics frs sh2"
        using FAssThrow21.prems Jcc_pieces_FAss2[OF pcs, of h1 w ls1 sh1] by auto
      have ?err using Jcc_pieces_FAss2[OF pcs, of h1 w ls1 sh1] pc2 jvm_trans[OF 1 2]
        by(auto intro!: exI[where x=pc2] exI[where x="vs'@[w]"])
    }
    thus "?eq  ?err" by simp
  qed
next
  case (FAssThrow11 e1 h0 ls0 sh0 e' h1 ls1 sh1 F D e2)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (e1F{D} := e2)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (e1F{D} := e2)),ics)#frs,sh1), err)"
    using FAssThrow11.prems(1) by clarsimp
  have IH1: "PROP ?P e1 h0 ls0 sh0 (throw e') h1 ls1 sh1 E C M pc ics v xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  show ?case using IH1 Jcc_pieces_FAss1[OF pcs, of h1 ls1 sh1 v] FAssThrow11.prems nsub_RI_Jcc_pieces
    by auto
next
  case (FAssNone1 e1 h0 ls0 sh0 a h1 ls1 sh1 e2 w h2 ls2 sh2 C' fs F D)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e1F{D} := e2)
    = (True, frs', (None,h2,(v#vs,ls2,C,M,pc+size(compE2 (e1F{D} := e2)),ics)#frs,sh2), err)"
    using FAssNone1.prems(1) by clarsimp
  let ?pc1 = "pc + length(compE2 e1)"
  let ?pc2 = "?pc1 + length(compE2 e2)"
  let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
  have IH1: "PROP ?P e1 h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 (Val w) h2 ls2 sh2 E C M ?pc1 ics w xa (Addr a#vs) frs
                     (I - pcs(compxE2 e1 pc (size vs)))" by fact
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Addr a#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using IH1 Jcc_pieces_FAss1[OF pcs, of h1 ls1 sh1 "Addr a"] by simp
  also have "P   -jvm→ (None,h2,(w#Addr a#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
    using IH2 Jcc_pieces_FAss2[OF pcs, of h1 "Addr a" ls1 sh1 w] by (simp add: add.assoc)
  also have "P   -jvm→ handle P C M ?xa h2 (w#Addr a#vs) ls2 ?pc2 ics frs sh2"
    using FAssNone1 by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc2] exI[where x="w#[Addr a]"])
next
  case (FAssStatic1 e1 h0 ls0 sh0 a h1 ls1 sh1 e2 w h2 ls2 sh2 C' fs F T D)
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (e1F{D} := e2)
    = (True, frs', (None,h2,(v#vs,ls2,C,M,pc+size(compE2 (e1F{D} := e2)),ics)#frs,sh2), err)"
    using FAssStatic1.prems(1) by clarsimp
  have "P1  D sees F,Static:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAssStatic1.hyps(6)]])
  then have field: "field P D F = (D,Static,T)" by simp
  let ?pc1 = "pc + length(compE2 e1)"
  let ?pc2 = "?pc1 + length(compE2 e2)"
  let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
  have IH1: "PROP ?P e1 h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs
                     (I - pcs (compxE2 e2 (pc + length (compE2 e1)) (Suc (length vs))))" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 (Val w) h2 ls2 sh2 E C M ?pc1 ics w xa (Addr a#vs) frs
                     (I - pcs(compxE2 e1 pc (size vs)))" by fact
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(Addr a#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using IH1 Jcc_pieces_FAss1[OF pcs, of h1 ls1 sh1 "Addr a"] by simp
  also have "P   -jvm→ (None,h2,(w#Addr a#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
    using IH2 Jcc_pieces_FAss2[OF pcs, of h1 "Addr a" ls1 sh1 w] by (simp add: add.assoc)
  also have "P   -jvm→ handle P C M ?xa h2 (w#Addr a#vs) ls2 ?pc2 ics frs sh2"
    using FAssStatic1 field by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc2] exI[where x="w#[Addr a]"])
next
  case (SFAss1 e2 h0 ls0 sh0 w h1 ls1 sh1 C' F T D sfs sfs' sh1')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (C'sF{D} := e2)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (C'sF{D} := e2)),ics)#frs,sh1), err)"
    using SFAss1.prems(1) by clarsimp
  have "P1  D sees F,Static:T in D" by(rule has_field_sees[OF has_field_idemp[OF SFAss1.hyps(3)]])
  then have field: "field P D F = (D,Static,T)" by simp
  have IH: "PROP ?P e2 h0 ls0 sh0 (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs I" by fact
  let ?pc = "pc + length(compE2 e2)"
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(w#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp
  also have "P   -jvm→ (None,h1,(vs,ls1,C,M,?pc+1,ics)#frs,sh1')"
    using SFAss1.hyps(3-6) SFAss1.prems(1) field by auto
  also have "P  ... -jvm→ (None,h1,(Unit#vs,ls1,C,M,?pc+2,ics)#frs,sh1')"
    using SFAss1 by auto
  finally show ?case using pcs by auto
next
  case (SFAssInit1 e2 h ls sh w h1 ls1 sh1 C' F t D v' h' ls' sh' sfs i sfs' sh'')
  let ?pc = "pc + length(compE2 e2)"
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh'' v xa (C'sF{D}:=e2)
    = (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE2 (C'sF{D}:=e2)),ics)#frs,sh''), err)"
    using SFAssInit1.prems(1) by clarsimp
  have "Ex (WTrt21 P1 E h1 sh1 (INIT D ([D],False)  unit))"
    using has_field_is_class'[OF SFAssInit1.hyps(3)] by auto
  then obtain err' where pcs':
    "Jcc_pieces P1 E C M h1 (w#vs) ls1 ?pc ics frs sh1 I h' ls' sh' v' xa (INIT D ([D],False)  unit)
    = (True, (w#vs,ls1,C,M,?pc,Calling D []) # frs,
       (None,h',(w#vs,ls1,C,M,?pc,Called [])#frs,sh'), err')"
    using SFAssInit1.prems(1) by simp
  have ls: "ls1 = ls'" by(rule init1_same_loc[OF SFAssInit1.hyps(5)])
  have has: "P1  D has F,Static:t in D" by(rule has_field_idemp[OF SFAssInit1.hyps(3)])
  have "P1  D sees F,Static:t in D" by(rule has_field_sees[OF has])
  then have field: "field P D F = (D,Static,t)" by simp
  have IH: "PROP ?P e2 h ls sh (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs I" by fact
  have IHI: "PROP ?P (INIT D ([D],False)  unit) h1 ls1 sh1 (Val v')
             h' ls' sh' E C M ?pc ics v' xa (w#vs) frs I" by fact
  have "P  (None,h,frs',sh) -jvm→ (None,h1,(w#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_SFAss[OF pcs, where v'=w] by simp
  also have "P   -jvm→ (None,h1,(w#vs,ls1,C,M,?pc,Calling D [])#frs,sh1)"
  proof(cases "sh1 D")
    case None then show ?thesis using None SFAssInit1.hyps(1,3-5,7-9) SFAssInit1.prems field
      by(cases ics, auto)
  next
    case (Some a)
    then obtain sfs i where "a = (sfs,i)" by(cases a)
    then show ?thesis using SFAssInit1.hyps(1,3-5,7-9) SFAssInit1.prems field Some
      by(cases ics; case_tac i) auto
  qed
  also have "P  ... -jvm→ (None, h', (w#vs, ls1, C, M, ?pc, Called []) # frs, sh')"
    using IHI pcs' by clarsimp
  also have "P  ... -jvm→ (None, h', (vs, ls1, C, M, ?pc + 1, ics) # frs, sh'')"
    using SFAssInit1.hyps(1,3-5,7-9) SFAssInit1.prems has field by(cases ics) auto
  also have "P  ... -jvm→ (None, h', (Unit#vs, ls1, C, M, ?pc + 2, ics) # frs, sh'')"
    using SFAssInit1.hyps(1,3-5,7-9) SFAssInit1.prems has field by(cases ics) auto
  finally show ?case using pcs ls by simp blast
next
  case (SFAssInitThrow1 e2 h ls sh w h1 ls1 sh1 C' F t D a h' ls' sh')
  let ?pc = "pc + length(compE2 e2)"
  obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C'sF{D}:=e2)
    = (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE2 (C'sF{D}:=e2)),ics)#frs,sh'), err)"
    using SFAssInitThrow1.prems(1) by clarsimp
  obtain a' where throw: "throw a = Throw a'" using eval1_final[OF SFAssInitThrow1.hyps(5)] by clarsimp
  have "Ex (WTrt21 P1 E h1 sh1 (INIT D ([D],False)  unit))"
    using has_field_is_class'[OF SFAssInitThrow1.hyps(3)] by auto
  then obtain vs' where pcs':
    "Jcc_pieces P1 E C M h1 (w#vs) ls1 ?pc ics frs sh1 I h' ls' sh' v a' (INIT D ([D],False)  unit)
    = (True, (w#vs,ls1,C,M,?pc,Calling D []) # frs, (None,h',(w#vs,ls1,C,M,?pc,Called [])#frs,sh'),
         P  (None,h1,(w#vs,ls1,C,M,?pc,Calling D []) # frs,sh1)
               -jvm→ handle P C M a' h' (vs'@w#vs) ls1 ?pc ics frs sh')"
    using SFAssInitThrow1.prems(1) by simp blast
  have ls: "ls1 = ls'" by(rule init1_same_loc[OF SFAssInitThrow1.hyps(5)])
  have has: "P1  D has F,Static:t in D" by(rule has_field_idemp[OF SFAssInitThrow1.hyps(3)])
  have "P1  D sees F,Static:t in D" by(rule has_field_sees[OF has])
  then have field: "field P D F = (D,Static,t)" by simp
  have IH: "PROP ?P e2 h ls sh (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs I" by fact
  have IHI: "PROP ?P (INIT D ([D],False)  unit) h1 ls1 sh1 (throw a)
             h' ls' sh' E C M ?pc ics v a' (w#vs) frs I" by fact
  have "P  (None,h,(vs, ls, C, M, pc, ics) # frs,sh) -jvm→ (None,h1,(w#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp blast
  also have "P   -jvm→ (None,h1,(w#vs,ls1,C,M,?pc,Calling D [])#frs,sh1)"
  proof(cases "sh1 D")
    case None then show ?thesis using SFAssInitThrow1.hyps(1,3,4,5) SFAssInitThrow1.prems field
      by(cases ics) auto
  next
    case (Some a)
    then obtain sfs i where "a = (sfs,i)" by(cases a)
    then show ?thesis using SFAssInitThrow1.hyps(1,3,4,5) SFAssInitThrow1.prems field Some
      by(cases ics; case_tac i) auto
  qed
  also have "P  ... -jvm→ handle P C M a' h' (vs'@w#vs) ls1 ?pc ics frs sh'"
    using IHI pcs' throw by auto
  finally show ?case using throw ls by(auto intro!: exI[where x = ?pc] exI[where x="vs'@[w]"])
next
  case (SFAssThrow1 e2 h0 ls0 sh0 e' h1 ls1 sh1 C' F D)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (C'sF{D} := e2)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (C'sF{D} := e2)),ics)#frs,sh1), err)"
    using SFAssThrow1.prems(1) by clarsimp
  have IH: "PROP ?P e2 h0 ls0 sh0 (throw e') h1 ls1 sh1 E C M pc ics v xa vs frs I" by fact
  show ?case using IH Jcc_pieces_SFAss[OF pcs, where v'=v] SFAssThrow1.prems nsub_RI_Jcc_pieces
    less_Suc_eq by auto
next
  case (SFAssNone1 e2 h0 ls0 sh0 w h1 ls1 sh1 C' F D)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (C'sF{D} := e2)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (C'sF{D} := e2)),ics)#frs,sh1), err)"
    using SFAssNone1.prems(1) by clarsimp
  have IH: "PROP ?P e2 h0 ls0 sh0 (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs I" by fact
  let ?pc = "pc + length(compE2 e2)"
  let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(w#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp
  also have "P   -jvm→ handle P C M ?xa h1 (w#vs) ls1 ?pc ics frs sh1"
    using SFAssNone1 by(cases ics; clarsimp simp add: handle_def)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[w]"])
next
  case (SFAssNonStatic1 e2 h0 ls0 sh0 w h1 ls1 sh1 C' F T D)
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h1 ls1 sh1 v xa (C'sF{D} := e2)
    = (True, frs', (None,h1,(v#vs,ls1,C,M,pc+size(compE2 (C'sF{D} := e2)),ics)#frs,sh1), err)"
    using SFAssNonStatic1.prems(1) by clarsimp
  have IH: "PROP ?P e2 h0 ls0 sh0 (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs I" by fact
  let ?pc = "pc + length(compE2 e2)"
  let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
  have "P1  D sees F,NonStatic:T in D"
    by(rule has_field_sees[OF has_field_idemp[OF SFAssNonStatic1.hyps(3)]])
  then have field: "field P D F = (D,NonStatic,T)" by simp
  have "P  (None,h0,frs',sh0) -jvm→ (None,h1,(w#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp
  also have "P   -jvm→ handle P C M ?xa h1 (w#vs) ls1 ?pc ics frs sh1"
    using SFAssNonStatic1
    proof(cases ics)
      case No_ics
      then show ?thesis using SFAssNonStatic1 field
       by (auto simp:split_beta handle_def simp del: split_paired_Ex)
    qed(simp_all)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[w]"])
next
  case (Call1 e h0 ls0 sh0 a h1 ls1 sh1 es pvs h2 ls2 sh2 Ca fs M' Ts T body D ls2' f h3 ls3 sh3)
  let ?frs0 = "(vs, ls0, C,M,pc,ics)#frs"
  let 0 = "(None,h0,?frs0,sh0)"
  let ?pc1 = "pc + length(compE2 e)"
  let 1 = "(None,h1,(Addr a#vs, ls1, C,M,?pc1,ics)#frs,sh1)"
  let ?pc2 = "?pc1 + length(compEs2 es)"
  let ?frs2 = "(rev pvs @ Addr a # vs, ls2, C,M,?pc2,ics)#frs"
  let 2 = "(None,h2,?frs2,sh2)"
  let ?frs2' = "([], ls2', D,M',0,No_ics) # ?frs2"
  let 2' = "(None, h2, ?frs2', sh2)"
  have nclinit: "M'  clinit" using wf_sees_clinit1[OF wf] visible_method_exists[OF Call1.hyps(6)]
    sees_method_idemp[OF Call1.hyps(6)] by fastforce
  have "P1 1 es,(h1, ls1, sh1) [⇒] map Val pvs,(h2, ls2, sh2)" by fact
  hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
  have invoke: "P,C,M,?pc2  Invoke M' (length Ts)"
    using Call1.hyps(7) Call1.prems(1) by clarsimp
  have nsub: "¬ sub_RI body" by(rule sees_wf1_nsub_RI[OF wf Call1.hyps(6)])
  obtain err where pcs:
    "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h3 ls2 sh3 v xa (eM'(es)) =
    (True, ?frs0, (None, h3, (v#vs, ls2, C,M,?pc2+1,ics)#frs,sh3), err)"
   using Call1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs
    (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs))))" by fact
  have IH_es: "PROP ?Ps es h1 ls1 sh1 (map Val pvs) h2 ls2 sh2 C M ?pc1 ics pvs xa
                    (map Val pvs) (Addr a#vs) frs (I - pcs(compxE2 e pc (size vs)))" by fact
  have "P  0 -jvm→ 1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
  also have "P   -jvm→ 2" using IH_es Call1.prems by fastforce
  also have "P   -jvm→ 2'"
    using jvm_Invoke[OF assms(1) invoke _ Call1.hyps(6-8)] Call1.hyps(5) Call1.prems(1) by simp
  finally have 1: "P  0 -jvm→ 2'".
  have "P1  Ca sees M',NonStatic: TsT = body in D" by fact
  then have M'_in_D: "P1  D sees M',NonStatic: TsT = body in D"
    by(rule sees_method_idemp) 
  have M'_code: "compP2 P1,D,M',0  compE2 body @ [Return]" using beforeM M'_in_D by simp
  have M'_xtab: "compP2 P1,D,M'  compxE2 body 0 0/{..<size(compE2 body)},0"
    using M'_in_D by(rule beforexM)
  have IH_body: "PROP ?P body h2 ls2' sh2 f h3 ls3 sh3 (Class D # Ts) D M' 0 No_ics v xa [] ?frs2
    ({..<size(compE2 body)})" by fact
  have cond: "Jcc_cond P1 (Class D # Ts) D M' [] 0 No_ics {..<length (compE2 body)} h2 sh2 body"
    using nsub_RI_Jcc_pieces[OF assms(1) nsub] M'_code M'_xtab by clarsimp
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm (is "?val  ?trans")
    proof
      assume val: ?val
      note 1
      also have "P  2' -jvm→ (None,h3,([v],ls3,D,M',size(compE2 body),No_ics)#?frs2,sh3)"
        using val IH_body Call1.prems M'_code cond nsub_RI_Jcc_pieces nsub by auto
      also have "P   -jvm→ (None, h3, (v#vs, ls2, C,M,?pc2+1,ics)#frs,sh3)"
        using Call1.hyps(7) M'_code M'_in_D nclinit by(cases T, auto)
      finally show ?trans by(simp add:add.assoc)
    qed
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw: ?throw
      with IH_body obtain pc2 vs' where
        pc2: "0  pc2  pc2 < size(compE2 body) 
              ¬ caught P pc2 h3 xa (compxE2 body 0 0)" and
        2: "P  2' -jvm→ handle P D M' xa h3 vs' ls3 pc2 No_ics ?frs2 sh3"
        using Call1.prems M'_code M'_xtab cond nsub_RI_Jcc_pieces nsub
         by (auto simp del:split_paired_Ex)
      have "handle P D M' xa h3 vs' ls3 pc2 No_ics ?frs2 sh3 =
            handle P C M xa h3 (rev pvs @ Addr a # vs) ls2 ?pc2 ics frs sh3"
        using pc2 M'_in_D nclinit by(auto simp add:handle_def)
      then show "?err" using pc2 jvm_trans[OF 1 2]
       by(auto intro!:exI[where x="?pc2"] exI[where x="rev pvs@[Addr a]"])
    qed
  qed
next
  case (CallParamsThrow1 e h0 ls0 sh0 w h1 ls1 sh1 es es' h2 ls2 sh2 pvs ex es'' M')
  let ?frs0 = "(vs, ls0, C,M,pc,ics)#frs"
  let 0 = "(None,h0,(vs, ls0, C,M,pc,ics)#frs,sh0)"
  let ?pc1 = "pc + length(compE2 e)"
  let 1 = "(None,h1,(w # vs, ls1, C,M,?pc1,ics)#frs,sh1)"
  let ?pc2 = "?pc1 + length(compEs2 es)"
  obtain err where pcs:
    "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (eM'(es)) =
    (True, ?frs0, (None, h2, (v#vs, ls2, C,M,?pc2+1,ics)#frs,sh2), err)"
   using CallParamsThrow1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs
    (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs))))" by fact
  have 1: "P  0 -jvm→ 1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
  have Isubs: "{?pc1..<?pc2}  I - pcs (compxE2 e pc (length vs))"
    using CallParamsThrow1.prems by clarsimp
  show ?case (is "?N  (?eq  ?err)")
  proof
    show ?N by simp
  next
    { assume ?eq
      moreover
      have "PROP ?Ps es h1 ls1 sh1 es' h2 ls2 sh2 C M ?pc1 ics pvs xa es'' (w#vs) frs
        (I - pcs (compxE2 e pc (length vs)))" by fact
      ultimately obtain vs' where "pc2.
        (?pc1  pc2  pc2 < ?pc1 + size(compEs2 es) 
         ¬ caught P pc2 h2 xa (compxEs2 es ?pc1 (size vs + 1))) 
        P  1 -jvm→ handle P C M xa h2 (vs'@w#vs) ls2 pc2 ics frs sh2"
        (is "pc2. ?PC pc2  ?Exec pc2")
        using CallParamsThrow1 Isubs by auto
      then obtain pc2 where pc2: "?PC pc2" and 2: "?Exec pc2" by iprover
      then have "?err" using pc2 jvm_trans[OF 1 2]
       by(auto intro!: exI[where x="pc2"] exI[where x="vs'@[w]"])
    }
    thus "?eq  ?err" by simp
  qed
next
  case (CallNull1 e h0 ls0 sh0 h1 ls1 sh1 es pvs h2 ls2 sh2 M')
  have "P1 1 es,(h1, ls1, sh1) [⇒] map Val pvs,(h2, ls2, sh2)" by fact
  hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
  let ?frs0 = "(vs, ls0, C,M,pc,ics)#frs"
  let ?pc1 = "pc + length(compE2 e)"
  let ?pc2 = "?pc1 + length(compEs2 es)"
  let ?xa = "addr_of_sys_xcpt NullPointer"
  obtain err where pcs:
    "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (eM'(es)) =
    (True, ?frs0, (None, h2, (v#vs, ls2, C,M,?pc2+1,ics)#frs,sh2), err)"
   using CallNull1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 null h1 ls1 sh1 E C M pc ics Null xa vs frs
    (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs))))" by fact
  have IH_es: "PROP ?Ps es h1 ls1 sh1 (map Val pvs) h2 ls2 sh2 C M ?pc1 ics pvs xa
                    (map Val pvs) (Null#vs) frs (I - pcs(compxE2 e pc (size vs)))" by fact
  have Isubs: "{pc + length (compE2 e)..<pc + length (compE2 e) + length (compEs2 es)}
      I - pcs (compxE2 e pc (length vs))" using CallNull1.prems by clarsimp
  have "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
             (None,h1,(Null#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using Jcc_pieces_Call1[OF pcs] IH by clarsimp
  also have "P   -jvm→ (None,h2,(rev pvs@Null#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
    using CallNull1 IH_es Isubs by auto
  also have "P   -jvm→ handle P C M ?xa h2 (rev pvs@Null#vs) ls2 ?pc2 ics frs sh2"
    using CallNull1.prems
    by(auto simp:split_beta handle_def nth_append simp del: split_paired_Ex)
  finally show ?case by (auto intro!: exI[where x = ?pc2] exI[where x="rev pvs@[Null]"])
next
  case (CallObjThrow1 e h ls sh e' h' ls' sh' M' es)
  obtain err where pcs:
    "Jcc_pieces P1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (eM'(es)) =
    (True, (vs, ls, C,M,pc,ics)#frs,
       (None, h', (v#vs, ls', C,M,pc+size(compE2 (eM'(es))),ics)#frs,sh'), err)"
   using CallObjThrow1.prems(1) by clarsimp
  obtain a' where throw: "throw e' = Throw a'"
    using eval1_final[OF CallObjThrow1.hyps(1)] by clarsimp
  have IH: "PROP ?P e h ls sh (throw e') h' ls' sh' E C M pc ics v a' vs frs
    (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs))))" by fact
  show ?case using IH Jcc_pieces_Call1[OF pcs] throw CallObjThrow1.prems nsub_RI_Jcc_pieces
    by auto
next
  case (CallNone1 e h0 ls0 sh0 a h1 ls1 sh1 es pvs h2 ls2 sh2 C' fs M')
  let ?frs0 = "(vs, ls0, C,M,pc,ics)#frs"
  let 0 = "(None,h0,?frs0,sh0)"
  let ?pc1 = "pc + length(compE2 e)"
  let 1 = "(None,h1,(Addr a#vs, ls1, C,M,?pc1,ics)#frs,sh1)"
  let ?pc2 = "?pc1 + length(compEs2 es)"
  let ?frs2 = "(rev pvs @ Addr a # vs, ls2, C,M,?pc2,ics)#frs"
  let 2 = "(None,h2,?frs2,sh2)"
  let ?xa = "addr_of_sys_xcpt NoSuchMethodError"
  have "P1 1 es,(h1, ls1, sh1) [⇒] map Val pvs,(h2, ls2, sh2)" by fact
  hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
  have aux: "(rev pvs @ Addr a # vs) ! length pvs = Addr a"
    by (metis length_rev nth_append_length)
  have nmeth: "¬(b Ts T body D. P  C' sees M', b :  TsT = body in D)"
    using sees_method_compPD CallNone1.hyps(6) by fastforce
  obtain err where pcs:
    "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (eM'(es)) =
    (True, ?frs0, (None, h2, (v#vs, ls2, C,M,?pc2+1,ics)#frs,sh2), err)"
   using CallNone1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs
    (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs))))" by fact
  have IH_es: "PROP ?Ps es h1 ls1 sh1 (map Val pvs) h2 ls2 sh2 C M ?pc1 ics pvs xa
                    (map Val pvs) (Addr a#vs) frs (I - pcs(compxE2 e pc (size vs)))" by fact
  have "P  0 -jvm→ 1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
  also have "P   -jvm→ 2" using IH_es CallNone1.prems by fastforce
  also have "P   -jvm→ handle P C M ?xa h2 (rev pvs@Addr a#vs) ls2 ?pc2 ics frs sh2"
    using CallNone1.hyps(5) CallNone1.prems aux nmeth
     by(cases "method P C' M'", cases "find_handler P ?xa h2 frs sh2", auto simp: handle_def)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc2] exI[where x="rev pvs@[Addr a]"])
next
  case (CallStatic1 e h0 ls0 sh0 a h1 ls1 sh1 es pvs h2 ls2 sh2 C' fs M' Ts T body D)
  let ?frs0 = "(vs, ls0, C,M,pc,ics)#frs"
  let 0 = "(None,h0,?frs0,sh0)"
  let ?pc1 = "pc + length(compE2 e)"
  let 1 = "(None,h1,(Addr a#vs, ls1, C,M,?pc1,ics)#frs,sh1)"
  let ?pc2 = "?pc1 + length(compEs2 es)"
  let ?frs2 = "(rev pvs @ Addr a # vs, ls2, C,M,?pc2,ics)#frs"
  let 2 = "(None,h2,?frs2,sh2)"
  let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
  have "P1 1 es,(h1, ls1, sh1) [⇒] map Val pvs,(h2, ls2, sh2)" by fact
  hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
  have aux: "(rev pvs @ Addr a # vs) ! length pvs = Addr a"
    by (metis length_rev nth_append_length)
  obtain body' where method: "P  C' sees M', Static :  TsT = body' in D"
    by (metis CallStatic1.hyps(6) P_def compP2_def sees_method_compP)
  obtain err where pcs:
    "Jcc_pieces P1 E C M h0 vs ls0 pc ics frs sh0 I h2 ls2 sh2 v xa (eM'(es)) =
    (True, ?frs0, (None, h2, (v#vs, ls2, C,M,?pc2+1,ics)#frs,sh2), err)"
   using CallStatic1.prems(1) by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) xa vs frs
    (I - pcs (compxEs2 es (pc + length (compE2 e)) (Suc (length vs))))" by fact
  have IH_es: "PROP ?Ps es h1 ls1 sh1 (map Val pvs) h2 ls2 sh2 C M ?pc1 ics pvs xa
                    (map Val pvs) (Addr a#vs) frs (I - pcs(compxE2 e pc (size vs)))" by fact
  have "P  0 -jvm→ 1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
  also have "P   -jvm→ 2" using IH_es CallStatic1.prems by fastforce
  also have "P   -jvm→ handle P C M ?xa h2 (rev pvs@Addr a#vs) ls2 ?pc2 ics frs sh2"
    using CallStatic1.hyps(5) CallStatic1.prems aux method
     by(cases "method P C' M'", cases "find_handler P ?xa h2 frs sh2")
       (auto simp: handle_def; meson frames_of.cases)
  finally show ?case using pcs by (auto intro!: exI[where x = ?pc2] exI[where x="rev pvs@[Addr a]"])
next
  case (SCallParamsThrow1 es h1 ls1 sh1 es' h2 ls2 sh2 pvs ex es'' C' M')
  show ?case
  proof(cases "M' = clinit  es = []")
    case clinit: True then show ?thesis
      using SCallParamsThrow1.hyps(1,3) evals1_cases(1) by fastforce
  next
    case nclinit: False
    let 1 = "(None,h1,(vs, ls1, C,M,pc,ics)#frs,sh1)"
    let ?pc2 = "pc + length(compEs2 es)"
    have Isubs: "{pc..<pc + length (compEs2 es)}  I" using SCallParamsThrow1.prems nclinit by clarsimp
    show ?thesis (is "?N  (?eq  ?err)")
    proof
      show ?N by simp
    next
      { assume ?eq
        moreover
        have "PROP ?Ps es h1 ls1 sh1 es' h2 ls2 sh2 C M pc ics pvs xa es'' vs frs I" by fact
        ultimately have "pc2.
          (pc  pc2  pc2 < pc + size(compEs2 es) 
           ¬ caught P pc2 h2 xa (compxEs2 es pc (size vs))) 
          (vs'. P  1 -jvm→ handle P C M xa h2 (vs'@vs) ls2 pc2 ics frs sh2)"
          (is "pc2. ?PC pc2  ?Exec pc2")
          using SCallParamsThrow1 Isubs nclinit by auto
        then obtain pc2 where pc2: "?PC pc2" and 2: "?Exec pc2" by iprover
        then have "?err" using pc2 2 by(auto intro: exI[where x="pc2"])
      }
      thus "?eq  ?err" by iprover
    qed
  qed
next
  case (SCallNone1 es h1 ls1 sh1 pvs h2 ls2 sh2 C' M')
  show ?case
  proof(cases "M' = clinit  es = []")
    case clinit: True then show ?thesis using SCallNone1.hyps(3) SCallNone1.prems by auto
  next
    case nclinit: False
    let 1 = "(None,h1,(vs, ls1, C,M,pc,ics)#frs,sh1)"
    let ?pc2 = "pc + length(compEs2 es)"
    let ?frs2 = "(rev pvs @ vs, ls2, C,M,?pc2,ics)#frs"
    let 2 = "(None,h2,?frs2,sh2)"
    let ?xa = "addr_of_sys_xcpt NoSuchMethodError"
    have "P1 1 es,(h1, ls1, sh1) [⇒] map Val pvs,(h2, ls2, sh2)" by fact
    hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
    have nmeth: "¬(b Ts T body D. P  C' sees M', b :  TsT = body in D)"
      using sees_method_compPD SCallNone1.hyps(3) by fastforce
    have IH_es: "PROP ?Ps es h1 ls1 sh1 (map Val pvs) h2 ls2 sh2 C M pc ics pvs xa
                      (map Val pvs) vs frs I" by fact
    have "P  1 -jvm→ 2" using IH_es SCallNone1.prems nclinit by auto fastforce+
    also have "P   -jvm→ handle P C M ?xa h2 (rev pvs@vs) ls2 ?pc2 ics frs sh2"
      using SCallNone1.prems nmeth nclinit
       by(cases "method P C' M'", cases "find_handler P ?xa h2 frs sh2", auto simp: handle_def)
    finally show ?thesis using nclinit by (auto intro: exI[where x = ?pc2])
  qed
next
  case (SCallNonStatic1 es h1 ls1 sh1 pvs h2 ls2 sh2 C' M' Ts T body D)
  show ?case
  proof(cases "M' = clinit  es = []")
    case clinit: True then show ?thesis
      using SCallNonStatic1.hyps(3) SCallNonStatic1.prems sees_method_fun by fastforce
  next
    case nclinit: False
    let 1 = "(None,h1,(vs, ls1, C,M,pc,ics)#frs,sh1)"
    let ?pc2 = "pc + length(compEs2 es)"
    let ?frs2 = "(rev pvs @ vs, ls2, C,M,?pc2,ics)#frs"
    let 2 = "(None,h2,?frs2,sh2)"
    let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
    have "P1 1 es,(h1, ls1, sh1) [⇒] map Val pvs,(h2, ls2, sh2)" by fact
    hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
    obtain body' where method: "P  C' sees M', NonStatic :  TsT = body' in D"
      by (metis SCallNonStatic1.hyps(3) P_def compP2_def sees_method_compP)
    have IH_es: "PROP ?Ps es h1 ls1 sh1 (map Val pvs) h2 ls2 sh2 C M pc ics pvs xa
                      (map Val pvs) vs frs I" by fact
    have "P  1 -jvm→ 2" using IH_es SCallNonStatic1.prems nclinit by auto fastforce+
    also have "P   -jvm→ handle P C M ?xa h2 (rev pvs@vs) ls2 ?pc2 ics frs sh2"
      using SCallNonStatic1.prems method nclinit
       by(cases "method P C' M'", cases "find_handler P ?xa h2 frs sh2")
         (auto simp: handle_def; meson frames_of.cases)
    finally show ?thesis using nclinit by (auto intro: exI[where x = ?pc2])
  qed
next
  case (SCallInitThrow1 es h0 ls0 sh0 pvs h1 ls1 sh1 C' M' Ts T body D a h2 ls2 sh2)
  show ?case
  proof(cases "M' = clinit  es = []")
    case clinit: True then show ?thesis using SCallInitThrow1 by simp
  next
    case nclinit: False
    let 0 = "(None,h0,(vs, ls0, C,M,pc,ics)#frs,sh0)"
    let ?pc1 = "pc + length(compEs2 es)"
    let ?frs1 = "(rev pvs @ vs, ls1, C,M,?pc1,ics)#frs"
    let 1 = "(None,h1,?frs1,sh1)"
    let ?frs1' = "(rev pvs@vs,ls1,C,M,?pc1,Calling D [])#frs"
    let 1' = "(None,h1,?frs1',sh1)"
    let ?frs2 = "(rev pvs@vs,ls1,C,M,?pc1,Called [])#frs"
    let 2 = "(None,h2,?frs2,sh2)"
    have ls: "ls1 = ls2" by(rule init1_same_loc[OF SCallInitThrow1.hyps(6)])
    have method: "m'. P  C' sees M',Static:TsT = m' in D" using SCallInitThrow1.hyps(3)
      by (metis P_def compP2_def sees_method_compP)
    obtain a' where throw: "throw a = Throw a'" using eval1_final[OF SCallInitThrow1.hyps(6)] by clarsimp
    have "Ex (WTrt21 P1 E h1 sh1 (INIT D ([D],False)  unit))"
      using sees_method_is_class'[OF SCallInitThrow1.hyps(3)] by auto
    then obtain err' where pcs':
      "Jcc_pieces P1 E C M h1 (rev pvs@vs) ls1 ?pc1 ics frs sh1 I h2 ls2 sh2 v xa (INIT D ([D],False)  unit)
      = (True, ?frs1', (None,h2,?frs2,sh2), err')"
      using SCallInitThrow1.prems(1) nclinit by auto
    have IHI: "PROP ?P (INIT D ([D],False)  unit) h1 ls1 sh1 (throw a)
               h2 ls2 sh2 E C M ?pc1 ics v a' (rev pvs@vs) frs I" by fact
    have IH_es: "PROP ?Ps es h0 ls0 sh0 (map Val pvs) h1 ls1 sh1 C M pc ics pvs xa
                      (map Val pvs) vs frs I" by fact
    have "P  0 -jvm→ 1" using IH_es SCallInitThrow1.prems nclinit by auto fastforce+
    also have "P   -jvm→ 1'"
    proof(cases "sh1 D")
      case None then show ?thesis using SCallInitThrow1.hyps(1,3-6) SCallInitThrow1.prems method
        by(cases ics) auto
    next
      case (Some a)
      then obtain sfs i where "a = (sfs,i)" by(cases a)
      then show ?thesis using SCallInitThrow1.hyps(1,3-6) SCallInitThrow1.prems method Some
        by(cases ics; case_tac i, auto)
    qed
    also obtain vs' where "P   -jvm→ handle P C M a' h2 (vs'@rev pvs@vs) ls1 ?pc1 ics frs sh2"
      using IHI pcs' throw by auto
    finally show ?thesis using nclinit throw ls
     by(auto intro!: exI[where x="?pc1"] exI[where x="vs'@rev pvs"])
  qed
next
  case (SCallInit1 es h0 ls0 sh0 pvs h1 ls1 sh1 C' M' Ts T body D v' h2 ls2 sh2 ls2' e' h3 ls3 sh3)
  show ?case
  proof(cases "M' = clinit  es = []")
    case clinit: True then show ?thesis using SCallInit1 by simp
  next
    case nclinit: False
    let 0 = "(None,h0,(vs, ls0, C,M,pc,ics)#frs,sh0)"
    let ?pc1 = "pc + length(compEs2 es)"
    let ?frs1 = "(rev pvs @ vs, ls1, C,M,?pc1,ics)#frs"
    let 1 = "(None,h1,?frs1,sh1)"
    let ?frs1' = "(rev pvs@vs,ls1,C,M,?pc1,Calling D [])#frs"
    let 1' = "(None,h1,?frs1',sh1)"
    let ?frs2 = "(rev pvs@vs,ls1,C,M,?pc1,Called [])#frs"
    let 2 = "(None,h2,?frs2,sh2)"
    let ?frs2' = "([], ls2', D,M',0,No_ics) # ?frs1"
    let 2' = "(None, h2, ?frs2', sh2)"
    have nclinit': "M'  clinit" by fact
    have ics: "ics = No_ics" using SCallInit1.hyps(5) SCallInit1.prems by simp
    have "P1 1 es,(h0, ls0, sh0) [⇒] map Val pvs,(h1, ls1, sh1)" by fact
    hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
    have invoke: "P,C,M,?pc1  Invokestatic C' M' (length Ts)"
      using SCallInit1.hyps(8) SCallInit1.prems nclinit by(auto simp: add.assoc)
    have nsub: "¬ sub_RI body" by(rule sees_wf1_nsub_RI[OF wf SCallInit1.hyps(3)])
    have ls: "ls1 = ls2" by(rule init1_same_loc[OF SCallInit1.hyps(6)])
    obtain sfs i where sh2: "sh2 D = Some(sfs,i)"
      using init1_Val_PD[OF SCallInit1.hyps(6)] by clarsimp
    have method: "m'. P  C' sees M',Static:TsT = m' in D" using SCallInit1.hyps(3)
      by (metis P_def compP2_def sees_method_compP)
    have "Ex (WTrt21 P1 E h1 sh1 (INIT D ([D],False)  unit))"
      using sees_method_is_class'[OF SCallInit1.hyps(3)] by auto
    then obtain err' where pcs':
      "Jcc_pieces P1 E C M h1 (rev pvs@vs) ls1 ?pc1 ics frs sh1 I h2 ls2 sh2 v' xa (INIT D ([D],False)  unit)
      = (True, ?frs1', (None,h2,?frs2,sh2), err')"
      using SCallInit1.prems(1) nclinit by auto
    have IHI: "PROP ?P (INIT D ([D],False)  unit) h1 ls1 sh1 (Val v')
               h2 ls2 sh2 E C M ?pc1 ics v' xa (rev pvs@vs) frs I" by fact
    have IH_es: "PROP ?Ps es h0 ls0 sh0 (map Val pvs) h1 ls1 sh1 C M pc ics pvs xa
                      (map Val pvs) vs frs I" by fact
    have "P  0 -jvm→ 1" using IH_es SCallInit1.prems nclinit by auto fastforce+
    also have "P   -jvm→ 1'"
    proof(cases "sh1 D")
      case None then show ?thesis using SCallInit1.hyps(1,3-6,8-10) SCallInit1.prems method
        by(cases ics) auto
    next
      case (Some a)
      then obtain sfs i where "a = (sfs,i)" by(cases a)
      then show ?thesis using SCallInit1.hyps(1,3-6,8-10) SCallInit1.prems method Some
        by(cases ics; case_tac i, auto)
    qed
    also have "P   -jvm→ 2" using IHI pcs' by auto
    also have "P   -jvm→ 2'"
      using jvm_Invokestatic_Called[OF assms(1) invoke _ SCallInit1.hyps(3,8,9)] sh2 ics by auto
    finally have 1: "P  0 -jvm→ 2'".
    have "P1  C' sees M',Static: TsT = body in D" by fact
    then have M'_in_D: "P1  D sees M',Static: TsT = body in D"
      by(rule sees_method_idemp) 
    have M'_code: "compP2 P1,D,M',0  compE2 body @ [Return]" using beforeM M'_in_D by simp
    have M'_xtab: "compP2 P1,D,M'  compxE2 body 0 0/{..<size(compE2 body)},0"
      using M'_in_D by(rule beforexM)
    have IH_body: "PROP ?P body h2 ls2' sh2 e' h3 ls3 sh3 (Class D # Ts) D M' 0 No_ics v xa [] ?frs1
      ({..<size(compE2 body)})" by fact
    have cond: "Jcc_cond P1 (Class D # Ts) D M' [] 0 No_ics {..<length (compE2 body)} h2 sh2 body"
      using nsub_RI_Jcc_pieces[OF assms(1) nsub] M'_code M'_xtab by clarsimp
    show ?thesis (is "?Norm  ?Err")
    proof
      show ?Norm (is "?val  ?trans")
      proof
        assume val: ?val
        note 1
        also have "P  2' -jvm→ (None,h3,([v],ls3,D,M',size(compE2 body),No_ics)#?frs1,sh3)"
          using val IH_body SCallInit1.prems M'_code cond nsub_RI_Jcc_pieces nsub by auto
        also have "P   -jvm→ (None, h3, (v#vs, ls2, C,M,?pc1+1,ics)#frs,sh3)"
          using SCallInit1.hyps(8) M'_code M'_in_D ls nclinit' by(cases T, auto)
        finally show ?trans using nclinit by(auto simp:add.assoc)
      qed
    next
      show ?Err (is "?throw  ?err")
      proof
        assume throw: ?throw
        with IH_body obtain pc2 vs' where
          pc2: "0  pc2  pc2 < size(compE2 body) 
                ¬ caught P pc2 h3 xa (compxE2 body 0 0)" and
          2: "P  2' -jvm→ handle P D M' xa h3 vs' ls3 pc2 No_ics ?frs1 sh3"
          using SCallInit1.prems M'_code M'_xtab cond nsub_RI_Jcc_pieces nsub
           by (auto simp del:split_paired_Ex)
        have "handle P D M' xa h3 vs' ls3 pc2 No_ics ?frs1 sh3 =
              handle P C M xa h3 (rev pvs @ vs) ls2 ?pc1 ics frs sh3"
          using pc2 M'_in_D ls nclinit' by(auto simp add:handle_def)
        then show "?err" using pc2 jvm_trans[OF 1 2] nclinit
         by(auto intro!:exI[where x="?pc1"] exI[where x="rev pvs"])
      qed
    qed
  qed
next
  case (SCall1 es h1 ls1 sh1 pvs h2 ls2 sh2 C' M' Ts T body D sfs ls2' e' h3 ls3 sh3)
  show ?case
  proof(cases "M' = clinit  es = []")
    case clinit: True
    then have s1: "pvs = []" "h1 = h2" "ls1 = ls2" "sh1 = sh2"
      using SCall1.hyps(1) evals1_cases(1) by blast+
    then have ls2': "ls2' = replicate (max_vars body) undefined" using SCall1.hyps(6) clinit by simp
    let ?frs = "create_init_frame P C' # (vs, ls1, C,M,pc,ics)#frs"
    let 1 = "(None,h1,?frs,sh1)"
    have method: "P1  C' sees clinit,Static: []Void = body in C'"
      using SCall1.hyps(3) clinit s1(1) wf_sees_clinit[OF wf]
        by (metis is_class_def option.collapse sees_method_fun sees_method_is_class)
    then have M_code: "compP2 P1,C',clinit,0  compE2 body @ [Return]" by(rule beforeM)
    have pcs: "Jcc_pieces P1 E C M h1 vs ls1 pc ics frs sh1 I h3 ls2 sh3 v xa (C'sclinit([]))
         = (True, ?frs, (None, h3, tl ?frs, sh3(C'(fst(the(sh3 C')),Done))),
        P  (None, h1, ?frs, sh1) -jvm→
        (case ics of
     Called Cs  (None, h3, (vs, ls1, C, M, pc, Throwing Cs xa) # frs, sh3(C'  (fst (the (sh3 C')), Error)))))"
      using Jcc_pieces_clinit[OF assms(1),of E C M vs pc ics I h1 sh1 C' ls1 frs h3 ls2 sh3 v xa]
         SCall1.prems(1) clinit s1(1) by clarsimp
    have IH_body: "PROP ?P body h2 ls2' sh2 e' h3 ls3 sh3 [] C' clinit 0 No_ics v xa [] (tl ?frs)
     ({..<size(compE2 body)})" by fact
    show ?thesis (is "?Norm  ?Err")
    proof
      show ?Norm (is "?val  ?trans")
      proof
        assume val: ?val
        then have "P  1
           -jvm→ (None, h3, ([v], ls3, C', clinit, size(compE2 body), No_ics) # tl ?frs,sh3)"
          using IH_body Jcc_pieces_SCall_clinit_body[OF assms(1) wf pcs method] s1 ls2' by clarsimp
        also have "P   -jvm→ (None, h3, tl ?frs, sh3(C'(fst(the(sh3 C')),Done)))"
          using jvm_Return_Init[OF M_code] by simp
        finally show ?trans using pcs s1 clinit by simp
      qed
    next
      show ?Err (is "?throw  ?err")
      proof
        assume throw: ?throw
        with IH_body obtain pc2 vs2 where
          pc2: "0  pc2  pc2 < size(compE2 body) 
                ¬ caught P pc2 h3 xa (compxE2 body 0 0)" and
          2: "P  1 -jvm→ handle P C' clinit xa h3 vs2 ls3 pc2 No_ics (tl ?frs) sh3"
          using SCall1.prems Jcc_pieces_SCall_clinit_body[OF assms(1) wf pcs method] s1 ls2' by clarsimp
        show ?err using SCall1.prems(1) clinit
        proof(cases ics)
          case (Called Cs)
          note 2
          also have "handle P C' clinit xa h3 vs2 ls3 pc2 No_ics (tl ?frs) sh3
             = (None, h3, (vs, ls1, C, M, pc, Throwing (C'#Cs) xa) # frs, sh3)"
            using Called pc2 method by(simp add: handle_def)
          also have "P   -jvm→ (None, h3, (vs, ls1, C, M, pc, Throwing Cs xa) # frs,
             sh3(C'  (fst (the (sh3 C')), Error)))" using Called jvm_Throwing by simp
          finally show ?thesis using pcs clinit Called by(clarsimp intro!: exI[where x="[]"])
        qed(auto)
      qed
    qed
  next
    case nclinit: False
    let 1 = "(None,h1,(vs, ls1, C,M,pc,ics)#frs,sh1)"
    let ?pc2 = "pc + length(compEs2 es)"
    let ?frs2 = "(rev pvs @ vs, ls2, C,M,?pc2,ics)#frs"
    let 2 = "(None,h2,?frs2,sh2)"
    let ?frs2' = "([], ls2', D,M',0,No_ics) # ?frs2"
    let 2' = "(None, h2, ?frs2', sh2)"
    have nclinit': "M'  clinit"
     using wf_sees_clinit1[OF wf] visible_method_exists[OF SCall1.hyps(3)]
       sees_method_idemp[OF SCall1.hyps(3)] nclinit SCall1.hyps(5)
       evals1_preserves_elen[OF SCall1.hyps(1)] by fastforce
    have "P1 1 es,(h1, ls1, sh1) [⇒] map Val pvs,(h2, ls2, sh2)" by fact
    hence [simp]: "length es = length pvs" by(auto dest:evals1_preserves_elen)
    have invoke: "P,C,M,?pc2  Invokestatic C' M' (length Ts)"
      using SCall1.hyps(5) SCall1.prems nclinit by(auto simp: add.assoc)
    have nsub: "¬ sub_RI body" by(rule sees_wf1_nsub_RI[OF wf SCall1.hyps(3)])
    have IH_es: "PROP ?Ps es h1 ls1 sh1 (map Val pvs) h2 ls2 sh2 C M pc ics pvs xa
                      (map Val pvs) vs frs I" by fact
    have "P  1 -jvm→ 2" using IH_es SCall1.prems nclinit by auto fastforce+
    also have "P   -jvm→ 2'" using jvm_Invokestatic[OF assms(1) invoke _ SCall1.hyps(3,5,6)]
         SCall1.hyps(4) SCall1.prems nclinit by auto
    finally have 1: "P  1 -jvm→ 2'".
    have "P1  C' sees M',Static: TsT = body in D" by fact
    then have M'_in_D: "P1  D sees M',Static: TsT = body in D"
      by(rule sees_method_idemp) 
    have M'_code: "compP2 P1,D,M',0  compE2 body @ [Return]" using beforeM M'_in_D by simp
    have M'_xtab: "compP2 P1,D,M'  compxE2 body 0 0/{..<size(compE2 body)},0"
      using M'_in_D by(rule beforexM)
    have IH_body: "PROP ?P body h2 ls2' sh2 e' h3 ls3 sh3 (Class D # Ts) D M' 0 No_ics v xa [] ?frs2
      ({..<size(compE2 body)})" by fact
    have cond: "Jcc_cond P1 (Class D # Ts) D M' [] 0 No_ics {..<length (compE2 body)} h2 sh2 body"
      using nsub_RI_Jcc_pieces[OF assms(1) nsub] M'_code M'_xtab by clarsimp
    show ?thesis (is "?Norm  ?Err")
    proof
      show ?Norm (is "?val  ?trans")
      proof
        assume val: ?val
        note 1
        also have "P  2' -jvm→ (None,h3,([v],ls3,D,M',size(compE2 body),No_ics)#?frs2,sh3)"
          using val IH_body SCall1.prems M'_code cond nsub_RI_Jcc_pieces nsub by auto
        also have "P   -jvm→ (None, h3, (v#vs, ls2, C,M,?pc2+1,ics)#frs,sh3)"
          using SCall1.hyps(5) M'_code M'_in_D nclinit' by(cases T, auto)
        finally show ?trans using nclinit by(auto simp:add.assoc)
      qed
    next
      show ?Err (is "?throw  ?err")
      proof
        assume throw: ?throw
        with IH_body obtain pc2 vs' where
          pc2: "0  pc2  pc2 < size(compE2 body) 
                ¬ caught P pc2 h3 xa (compxE2 body 0 0)" and
          2: "P  2' -jvm→ handle P D M' xa h3 vs' ls3 pc2 No_ics ?frs2 sh3"
          using SCall1.prems M'_code M'_xtab cond nsub_RI_Jcc_pieces nsub
           by (auto simp del:split_paired_Ex)
        have "handle P D M' xa h3 vs' ls3 pc2 No_ics ?frs2 sh3 =
              handle P C M xa h3 (rev pvs @ vs) ls2 ?pc2 ics frs sh3"
          using pc2 M'_in_D nclinit' by(auto simp add:handle_def)
        then show "?err" using pc2 jvm_trans[OF 1 2] nclinit by(auto intro:exI[where x="?pc2"])
      qed
    qed
  qed
next
  case Block1 then show ?case using nsub_RI_Jcc_pieces by auto
next
  case (Seq1 e1 h0 ls0 sh0 w h1 ls1 sh1 e2 e2' h2 ls2 sh2)
  let ?pc1 = "pc + length(compE2 e1)"
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let 1 = "(None,h1,(vs,ls1,C,M,?pc1+1,ics)#frs,sh1)"
  let ?I = "I - pcs (compxE2 e2 (Suc ?pc1) (length vs))"
  have Isub: "{pc..<pc + length (compE2 e1)}  ?I" using Seq1.prems by clarsimp
  have IH: "PROP ?P e1 h0 ls0 sh0 (Val w) h1 ls1 sh1 E C M pc ics w xa vs frs ?I" by fact
  have "P  0 -jvm→ (None,h1,(w#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using Seq1.prems nsub_RI_Jcc_pieces IH Isub by auto
  also have "P   -jvm→ 1" using Seq1 by auto
  finally have eval1: "P  0 -jvm→ 1".
  let ?pc2 = "?pc1 + 1 + length(compE2 e2)"
  let ?I' = "I - pcs(compxE2 e1 pc (size vs))"
  have IH2: "PROP ?P e2 h1 ls1 sh1 e2' h2 ls2 sh2 E C M (?pc1+1) ics v xa vs frs
                     ?I'" by fact
  have Isub2: "{Suc (pc + length (compE2 e1))..<Suc (pc + length (compE2 e1) + length (compE2 e2))}
      ?I'" using Seq1.prems by clarsimp
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm (is "?val  ?trans")
    proof
      assume val: ?val
      note eval1
      also have "P  1 -jvm→ (None,h2,(v#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
        using val Seq1.prems nsub_RI_Jcc_pieces IH2 Isub2 by auto
      finally show ?trans by(simp add:add.assoc)
    qed
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw: ?throw
      then obtain pc2 vs' where
        pc2: "?pc1+1  pc2  pc2 < ?pc2 
              ¬ caught P pc2 h2 xa (compxE2 e2 (?pc1+1) (size vs))" and
        eval2: "P  1 -jvm→ handle P C M xa h2 (vs'@vs) ls2 pc2 ics frs sh2"
        using IH2 Seq1.prems nsub_RI_Jcc_pieces Isub2 by auto
      show "?err" using pc2 jvm_trans[OF eval1 eval2] by(auto intro: exI[where x=pc2])
    qed
  qed
next
  case (SeqThrow1 e0 h0 ls0 sh0 e h1 ls1 sh1 e1)
  let ?I = "I - pcs (compxE2 e1 (Suc (pc + length (compE2 e0))) (length vs))"
  obtain a' where throw: "throw e = Throw a'" using eval1_final[OF SeqThrow1.hyps(1)] by clarsimp
  have Isub: "{pc..<pc + length (compE2 e0)}  ?I" using SeqThrow1.prems by clarsimp
  have "PROP ?P e0 h0 ls0 sh0 (throw e) h1 ls1 sh1 E C M pc ics v a' vs frs ?I" by fact
  then show ?case using SeqThrow1.prems throw nsub_RI_Jcc_pieces Isub by auto
next
  case (CondT1 e h0 ls0 sh0 h1 ls1 sh1 e1 e' h2 ls2 sh2 e2)
  let ?pc1 = "pc + length(compE2 e)"
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let 1 = "(None,h1,(vs,ls1,C,M,?pc1+1,ics)#frs,sh1)"
  let ?d = "size vs"
  let ?xt1 = "compxE2 e1 (pc+size(compE2 e)+1) ?d"
  let ?xt2 = "compxE2 e2 (pc+size(compE2 e)+size(compE2 e1)+2) ?d"
  let ?I = "I - (pcs ?xt1  pcs ?xt2)"
  have Isub: "{pc..<pc + length (compE2 e)}  ?I" using CondT1.prems by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 true h1 ls1 sh1 E C M pc ics (Bool True) xa vs frs ?I" by fact
  have "P  0 -jvm→ (None,h1,(Bool(True)#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using CondT1.prems nsub_RI_Jcc_pieces IH Isub by(auto simp: Int_Un_distrib)
  also have "P   -jvm→ 1" using CondT1 by auto
  finally have eval1: "P  0 -jvm→ 1".
  let ?pc1' = "?pc1 + 1 + length(compE2 e1)"
  let ?pc2' = "?pc1' + 1 + length(compE2 e2)"
  let ?I' = "I - pcs(compxE2 e pc ?d) - pcs(compxE2 e2 (?pc1'+1) ?d)"
  have IH2: "PROP ?P e1 h1 ls1 sh1 e' h2 ls2 sh2 E C M (?pc1+1) ics v xa vs frs ?I'" by fact
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm (is "?val  ?trans")
    proof
      assume val: ?val
      note eval1
      also have "P  1 -jvm→ (None,h2,(v#vs,ls2,C,M,?pc1',ics)#frs,sh2)"
        using val CondT1.prems nsub_RI_Jcc_pieces IH2 by(fastforce simp:Int_Un_distrib)
      also have "P   -jvm→ (None,h2,(v#vs,ls2,C,M,?pc2',ics)#frs,sh2)"
        using CondT1 nsub_RI_Jcc_pieces by(auto simp:add.assoc)
      finally show ?trans by(simp add:add.assoc)
    qed
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw: ?throw
      moreover
      note IH2
      ultimately obtain pc2 vs' where
        pc2: "?pc1+1  pc2  pc2 < ?pc1' 
              ¬ caught P pc2 h2 xa (compxE2 e1 (?pc1+1) (size vs))" and
        eval2: "P  1 -jvm→ handle P C M xa h2 (vs'@vs) ls2 pc2 ics frs sh2"
        using CondT1.prems nsub_RI_Jcc_pieces by (fastforce simp:Int_Un_distrib)
      show "?err" using pc2 jvm_trans[OF eval1 eval2] by(auto intro: exI[where x=pc2])
    qed
  qed
next
  case (CondF1 e h0 ls0 sh0 h1 ls1 sh1 e2 e' h2 ls2 sh2 e1)
  let ?pc1 = "pc + length(compE2 e)"
  let ?pc2 = "?pc1 + 1 + length(compE2 e1)+ 1"
  let ?pc2' = "?pc2 + length(compE2 e2)"
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let 1 = "(None,h1,(vs,ls1,C,M,?pc2,ics)#frs,sh1)"
  let ?d = "size vs"
  let ?xt1 = "compxE2 e1 (pc+size(compE2 e)+1) ?d"
  let ?xt2 = "compxE2 e2 (pc+size(compE2 e)+size(compE2 e1)+2) ?d"
  let ?I = "I - (pcs ?xt1  pcs ?xt2)"
  let ?I' = "I - pcs(compxE2 e pc ?d) - pcs(compxE2 e1 (?pc1+1) ?d)"
  have pcs: "pcs(compxE2 e pc ?d)  pcs(?xt1 @ ?xt2) = {}"
    using CondF1.prems by (simp add:Int_Un_distrib)
  have Isub: "{pc..<pc + length (compE2 e)}  ?I" using CondF1.prems by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 false h1 ls1 sh1 E C M pc ics (Bool False) xa vs frs ?I" by fact
  have IH2: "PROP ?P e2 h1 ls1 sh1 e' h2 ls2 sh2 E C M ?pc2 ics v xa vs frs ?I'" by fact
  have "P  0 -jvm→ (None,h1,(Bool(False)#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using CondF1.prems nsub_RI_Jcc_pieces IH Isub pcs by auto
  also have "P   -jvm→ 1" using CondF1 by auto
  finally have eval1: "P  0 -jvm→ 1".
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm (is "?val  ?trans")
    proof
      assume val: ?val
      note eval1
      also have "P  1 -jvm→ (None,h2,(v#vs,ls2,C,M,?pc2',ics)#frs,sh2)"
        using val CondF1.prems nsub_RI_Jcc_pieces IH2 by(fastforce simp:Int_Un_distrib)
      finally show ?trans by(simp add:add.assoc)
    qed
  next
    show ?Err (is "?throw  ?err")
    proof
      let ?I' = "I - pcs(compxE2 e pc ?d) - pcs(compxE2 e1 (?pc1+1) ?d)"
      assume throw: ?throw
      then obtain pc2 vs' where
        pc2: "?pc2  pc2  pc2 < ?pc2' 
              ¬ caught P pc2 h2 xa (compxE2 e2 ?pc2 ?d)" and
        eval2: "P  1 -jvm→ handle P C M xa h2 (vs'@vs) ls2 pc2 ics frs sh2"
        using CondF1.prems nsub_RI_Jcc_pieces IH2 by(fastforce simp:Int_Un_distrib)
      show "?err" using pc2 jvm_trans[OF eval1 eval2] by(auto intro: exI[where x=pc2])
    qed
  qed
next
  case (CondThrow1 e h0 ls0 sh0 f h1 ls1 sh1 e1 e2)
  let ?d = "size vs"
  let ?xt1 = "compxE2 e1 (pc+size(compE2 e)+1) ?d"
  let ?xt2 = "compxE2 e2 (pc+size(compE2 e)+size(compE2 e1)+2) ?d"
  let ?I = "I - (pcs ?xt1  pcs ?xt2)"
  have Isub: "{pc..<pc + length (compE2 e)}  ?I" using CondThrow1.prems by clarsimp
  have "pcs(compxE2 e pc ?d)  pcs(?xt1 @ ?xt2) = {}"
    using CondThrow1.prems by (simp add:Int_Un_distrib)
  moreover have "PROP ?P e h0 ls0 sh0 (throw f) h1 ls1 sh1 E C M pc ics v xa vs frs ?I" by fact
  ultimately show ?case using CondThrow1.prems nsub_RI_Jcc_pieces Isub by auto
next
  case (WhileF1 e h0 ls0 sh0 h1 ls1 sh1 c)
  let ?pc = "pc + length(compE2 e)"
  let ?pc' = "?pc + length(compE2 c) + 3"
  have Isub: "{pc..<pc + length (compE2 e)}  I - pcs (compxE2 c (Suc (pc + length (compE2 e))) (length vs))"
    using WhileF1.prems by clarsimp
  have Isub2: "{Suc (pc + length (compE2 e))..<Suc (pc + length (compE2 e) + length (compE2 c))}
      I - pcs (compxE2 e pc (length vs))" using WhileF1.prems by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 false h1 ls1 sh1 E C M pc ics (Bool False) xa vs frs
    (I - pcs (compxE2 c (Suc (pc + length (compE2 e))) (length vs)))" by fact
  have "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
            (None,h1,(Bool False#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using WhileF1.prems nsub_RI_Jcc_pieces IH Isub by auto
  also have "P   -jvm→ (None,h1,(vs,ls1,C,M,?pc',ics)#frs,sh1)"
    using WhileF1 by (auto simp:add.assoc)
  also have "P   -jvm→ (None,h1,(Unit#vs,ls1,C,M,?pc'+1,ics)#frs,sh1)"
    using WhileF1.prems by (auto simp:eval_nat_numeral)
  finally show ?case by (simp add:add.assoc eval_nat_numeral)
next
  case (WhileT1 e h0 ls0 sh0 h1 ls1 sh1 c v1 h2 ls2 sh2 e3 h3 ls3 sh3)
  let ?pc = "pc + length(compE2 e)"
  let ?pc' = "?pc + length(compE2 c) + 1"
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let 2 = "(None,h2,(vs,ls2,C,M,pc,ics)#frs,sh2)"
  have Isub: "{pc..<pc + length (compE2 e)}  I - pcs (compxE2 c (Suc (pc + length (compE2 e))) (length vs))"
    using WhileT1.prems by clarsimp
  have Isub2: "{Suc (pc + length (compE2 e))..<Suc (pc + length (compE2 e) + length (compE2 c))}
      I - pcs (compxE2 e pc (length vs))" using WhileT1.prems by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 true h1 ls1 sh1 E C M pc ics (Bool True) xa vs frs
    (I - pcs (compxE2 c (Suc (pc + length (compE2 e))) (length vs)))" by fact
  have IH2: "PROP ?P c h1 ls1 sh1 (Val v1) h2 ls2 sh2 E C M (Suc ?pc) ics v1 xa vs frs
    (I - pcs (compxE2 e pc (length vs)))" by fact
  have "P  0 -jvm→ (None,h1,(Bool True#vs,ls1,C,M,?pc,ics)#frs,sh1)"
    using WhileT1.prems nsub_RI_Jcc_pieces IH Isub by auto
  also have "P   -jvm→ (None,h1,(vs,ls1,C,M,?pc+1,ics)#frs,sh1)"
    using WhileT1.prems by auto
  also have "P   -jvm→ (None,h2,(v1#vs,ls2,C,M,?pc',ics)#frs,sh2)"
    using WhileT1.prems nsub_RI_Jcc_pieces IH2 Isub2 by auto
  also have "P   -jvm→ 2" using WhileT1.prems by auto
  finally have 1: "P  0 -jvm→ 2".
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm (is "?val  ?trans")
    proof
      assume val: ?val
      note 1
      also have "P  2 -jvm→ (None,h3,(v#vs,ls3,C,M,?pc'+3,ics)#frs,sh3)"
        using val WhileT1 by (auto simp add:add.assoc eval_nat_numeral)
      finally show ?trans by(simp add:add.assoc eval_nat_numeral)
    qed
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw: ?throw
      moreover
      have "PROP ?P (while (e) c) h2 ls2 sh2 e3 h3 ls3 sh3 E C M pc ics v xa vs frs I" by fact
      ultimately obtain pc2 vs' where
        pc2: "pc  pc2  pc2 < ?pc'+3 
              ¬ caught P pc2 h3 xa (compxE2 (while (e) c) pc (size vs))" and
        2: "P  2 -jvm→ handle P C M xa h3 (vs'@vs) ls3 pc2 ics frs sh3"
        using WhileT1.prems by (auto simp:add.assoc eval_nat_numeral)
      show "?err" using pc2 jvm_trans[OF 1 2] by(auto intro: exI[where x=pc2])
    qed
  qed
next
  case (WhileCondThrow1 e h ls sh e' h' ls' sh' c)
  let ?I = "I - pcs (compxE2 c (Suc (pc + length (compE2 e))) (length vs))"
  obtain a' where throw: "throw e' = Throw a'" using eval1_final[OF WhileCondThrow1.hyps(1)] by clarsimp
  have Isub: "{pc..<pc + length (compE2 e)}  ?I" using WhileCondThrow1.prems by clarsimp
  have "PROP ?P e h ls sh (throw e') h' ls' sh' E C M pc ics v a' vs frs ?I" by fact
  then show ?case using WhileCondThrow1.prems throw nsub_RI_Jcc_pieces Isub by auto
next
  case (WhileBodyThrow1 e h0 ls0 sh0 h1 ls1 sh1 c e' h2 ls2 sh2)
  let ?pc1 = "pc + length(compE2 e)"
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let 1 = "(None,h1,(vs,ls1,C,M,?pc1+1,ics)#frs,sh1)"
  let ?I = "I - pcs (compxE2 c (Suc (pc + length (compE2 e))) (length vs))"
  have Isub: "{pc..<pc + length (compE2 e)}  ?I"
    using WhileBodyThrow1.prems by clarsimp
  have IH: "PROP ?P e h0 ls0 sh0 true h1 ls1 sh1 E C M pc ics (Bool True) xa vs frs ?I" by fact
  then have "P  0 -jvm→ (None,h1,(Bool(True)#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using WhileBodyThrow1.prems nsub_RI_Jcc_pieces Isub by auto
  also have "P   -jvm→ 1" using  WhileBodyThrow1 by auto
  finally have eval1: "P  0 -jvm→ 1".
  let ?pc1' = "?pc1 + 1 + length(compE2 c)"
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm by simp
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw: ?throw
      moreover
      have "PROP ?P c h1 ls1 sh1 (throw e') h2 ls2 sh2 E C M (?pc1+1) ics v xa vs frs
                    (I - pcs (compxE2 e pc (size vs)))" by fact
      ultimately obtain pc2 vs' where
        pc2: "?pc1+1  pc2  pc2 < ?pc1' 
              ¬ caught P pc2 h2 xa (compxE2 c (?pc1+1) (size vs))" and
        eval2: "P  1 -jvm→ handle P C M xa h2 (vs'@vs) ls2 pc2 ics frs sh2"
        using WhileBodyThrow1.prems nsub_RI_Jcc_pieces by (fastforce simp:Int_Un_distrib)
      show "?err" using pc2 jvm_trans[OF eval1 eval2] by(auto intro: exI[where x=pc2])
    qed
  qed
next
  case (Throw1 e h0 ls0 sh0 a h1 ls1 sh1)
  let ?pc = "pc + size(compE2 e)"
  have Isub: "{pc..<pc + length (compE2 e)}  I" using Throw1.prems by clarsimp
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm by simp
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw:?throw
      have "PROP ?P e h0 ls0 sh0 (addr a) h1 ls1 sh1 E C M pc ics (Addr a) a vs frs I" by fact
      then have "P  (None, h0, (vs, ls0, C, M, pc, ics) # frs, sh0) -jvm→
                 (None, h1, (Addr xa#vs, ls1, C, M, ?pc, ics) # frs, sh1)"
        using Throw1 nsub_RI_Jcc_pieces Isub throw by auto
      also have "P   -jvm→ handle P C M xa h1 (Addr xa#vs) ls1 ?pc ics frs sh1"
        using Throw1.prems by(auto simp add:handle_def)
      finally show "?err" by(auto intro!: exI[where x="?pc"] exI[where x="[Addr xa]"])
    qed
  qed
next
  case (ThrowNull1 e h0 ls0 sh0 h1 ls1 sh1)
  let ?pc = "pc + size(compE2 e)"
  let ?xa = "addr_of_sys_xcpt NullPointer"
  have Isub: "{pc..<pc + length (compE2 e)}  I" using ThrowNull1.prems by clarsimp
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm by simp
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw: ?throw
      have "PROP ?P e h0 ls0 sh0 null h1 ls1 sh1 E C M pc ics Null xa vs frs I" by fact
      then have "P  (None, h0, (vs, ls0, C, M, pc, ics) # frs, sh0) -jvm→
                 (None, h1, (Null#vs, ls1, C, M, ?pc, ics) # frs, sh1)"
        using ThrowNull1.prems nsub_RI_Jcc_pieces Isub by auto
      also have "P   -jvm→  handle P C M ?xa h1 (Null#vs) ls1 ?pc ics frs sh1"
        using ThrowNull1.prems by(auto simp add:handle_def)
      finally show "?err" using throw by(auto intro!: exI[where x="?pc"] exI[where x="[Null]"])
    qed
  qed
next
  case (ThrowThrow1 e h ls sh e' h' ls' sh')
  obtain a' where throw: "throw e' = Throw a'" using eval1_final[OF ThrowThrow1.hyps(1)] by clarsimp
  have Isub: "{pc..<pc + length (compE2 e)}  I" using ThrowThrow1.prems by clarsimp
  have "PROP ?P e h ls sh (throw e') h' ls' sh' E C M pc ics v a' vs frs I" by fact
  then show ?case using ThrowThrow1.prems throw nsub_RI_Jcc_pieces Isub by auto
next
  case (Try1 e1 h0 ls0 sh0 v1 h1 ls1 sh1 Ci i e2)
  let ?pc1 = "pc + length(compE2 e1)"
  let ?pc1' = "?pc1 + 2 + length(compE2 e2)"
  have "{pc..<pc+size(compE2 (try e1 catch(Ci i) e2))}  I" using Try1.prems by simp
  also have "P,C,M  compxE2 (try e1 catch(Ci i) e2) pc (size vs) / I,size vs"
    using Try1.prems by simp
  ultimately have "P,C,M  compxE2 e1 pc (size vs) / {pc..<pc + length (compE2 e1)},size vs"
    by(rule beforex_try)
  hence "P  (None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0) -jvm→
             (None,h1,(v1#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
    using Try1 nsub_RI_Jcc_pieces by auto blast
  also have "P   -jvm→ (None,h1,(v1#vs,ls1,C,M,?pc1',ics)#frs,sh1)"
    using Try1.prems by auto
  finally show ?case by (auto simp:add.assoc)
next
  case (TryCatch1 e1 h0 ls0 sh0 a h1 ls1 sh1 D fs Ci i e2 e2' h2 ls2 sh2)
  let ?e = "try e1 catch(Ci i) e2"
  let ?xt = "compxE2 ?e pc (size vs)"
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let ?ls1 = "ls1[i := Addr a]"
  let ?pc1 = "pc + length(compE2 e1)"
  let ?pc1' = "?pc1 + 2"
  let 1 = "(None,h1,(vs,?ls1,C,M, ?pc1',ics) # frs,sh1)"
  have I: "{pc..<pc + length (compE2 (try e1 catch(Ci i) e2))}  I"
   and beforex: "P,C,M  ?xt/I,size vs" using TryCatch1.prems by simp+
  have "P  0 -jvm→ (None,h1,((Addr a)#vs,ls1,C,M, ?pc1+1,ics) # frs,sh1)"
  proof -
    have ics: "ics = No_ics" using TryCatch1.prems by auto
    have "PROP ?P e1 h0 ls0 sh0 (Throw a) h1 ls1 sh1 E C M pc ics v a vs frs {pc..<pc + length (compE2 e1)}"
      by fact
    moreover have "P,C,M  compxE2 e1 pc (size vs)/{pc..<?pc1},size vs"
      using beforex I pcs_subset by(force elim!: beforex_appendD1)
    ultimately have
      "pc1. pc  pc1  pc1 < ?pc1 
             ¬ caught P pc1 h1 a (compxE2 e1 pc (size vs)) 
             (vs'. P  0 -jvm→ handle P C M a h1 (vs'@vs) ls1 pc1 ics frs sh1)"
      using  TryCatch1.prems nsub_RI_Jcc_pieces by auto
    then obtain pc1 vs' where
      pc1_in_e1: "pc  pc1" "pc1 < ?pc1" and
      pc1_not_caught: "¬ caught P pc1 h1 a (compxE2 e1 pc (size vs))" and
      0: "P  0 -jvm→ handle P C M a h1 (vs'@vs) ls1 pc1 ics frs sh1" by iprover
    from beforex obtain xt0 xt1
      where ex_tab: "ex_table_of P C M = xt0 @ ?xt @ xt1"
      and disj: "pcs xt0  I = {}" by(auto simp:beforex_def)
    have hp: "h1 a = Some (D, fs)" "P1  D * Ci" by fact+
    have "pc1  pcs xt0" using pc1_in_e1 I disj by auto
    with pc1_in_e1 pc1_not_caught hp
    show ?thesis using ex_tab 0 ics by(simp add:handle_def matches_ex_entry_def)
  qed
  also have "P   -jvm→ 1" using TryCatch1 by auto
  finally have 1: "P  0 -jvm→ 1" .
  let ?pc2 = "?pc1' + length(compE2 e2)"
  let ?I2 = "{?pc1' ..< ?pc2}"
  have "P,C,M  compxE2 ?e pc (size vs) / I,size vs" by fact
  hence beforex2: "P,C,M  compxE2 e2 ?pc1' (size vs) / ?I2, size vs"
    using I pcs_subset[of _ ?pc1'] by(auto elim!:beforex_appendD2)
  have IH2: "PROP ?P e2 h1 ?ls1 sh1 e2' h2 ls2 sh2 E C M ?pc1' ics v xa vs frs ?I2" by fact
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm (is "?val  ?trans")
    proof
      assume val: ?val
      note 1 also have "P  1 -jvm→ (None,h2,(v#vs,ls2,C,M,?pc2,ics)#frs,sh2)"
        using val beforex2 IH2 TryCatch1.prems nsub_RI_Jcc_pieces by auto
      finally show ?trans by(simp add:add.assoc)
    qed
  next
    show ?Err (is "?throw  ?err")
    proof
      assume throw: ?throw
      then obtain pc2 vs' where
        pc2: "?pc1+2  pc2  pc2 < ?pc2 
              ¬ caught P pc2 h2 xa (compxE2 e2 ?pc1' (size vs))" and
        2: "P  1 -jvm→ handle P C M xa h2 (vs'@vs) ls2 pc2 ics frs sh2"
        using IH2 beforex2 TryCatch1.prems nsub_RI_Jcc_pieces by auto
      show ?err using pc2 jvm_trans[OF 1 2]
       by (simp add:match_ex_entry) (auto intro: exI[where x=pc2])
    qed
  qed
next
  case (TryThrow1 e1 h0 ls0 sh0 a h1 ls1 sh1 D fs Ci i e2)
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let ?pc1 = "pc + length(compE2 e1)"
  let ?e = "try e1 catch(Ci i) e2"
  let ?xt = "compxE2 ?e pc (size vs)"
  have I: "{pc..<pc + length (compE2 (try e1 catch(Ci i) e2))}  I"
   and beforex: "P,C,M  ?xt/I,size vs" using TryThrow1.prems by simp+
  have "PROP ?P e1 h0 ls0 sh0 (Throw a) h1 ls1 sh1 E C M pc ics v a vs frs 
   {pc..<pc + length (compE2 e1)}" by fact
  moreover have "P,C,M  compxE2 e1 pc (size vs)/{pc..<?pc1},size vs"
    using beforex I pcs_subset by(force elim!: beforex_appendD1)
    ultimately have
      "pc1. pc  pc1  pc1 < ?pc1 
             ¬ caught P pc1 h1 a (compxE2 e1 pc (size vs)) 
             (vs'. P  0 -jvm→ handle P C M a h1 (vs'@vs) ls1 pc1 ics frs sh1)"
      using TryThrow1.prems nsub_RI_Jcc_pieces by auto
    then obtain pc1 vs' where
      pc1_in_e1: "pc  pc1" "pc1 < ?pc1" and
      pc1_not_caught: "¬ caught P pc1 h1 a (compxE2 e1 pc (size vs))" and
      0: "P  0 -jvm→ handle P C M a h1 (vs'@vs) ls1 pc1 ics frs sh1" by iprover
  show ?case (is "?N  (?eq  ?err)")
  proof
    show ?N by simp
  next
    { assume ?eq
      with TryThrow1 pc1_in_e1 pc1_not_caught 0
      have "?err" by (simp add:match_ex_entry) auto
    }
    thus "?eq  ?err" by iprover
  qed
next
  case Nil1 thus ?case by simp
next
  case (Cons1 e h0 ls0 sh0 v h1 ls1 sh1 es fs h2 ls2 sh2)
  let ?pc1 = "pc + length(compE2 e)"
  let 0 = "(None,h0,(vs,ls0,C,M,pc,ics)#frs,sh0)"
  let 1 = "(None,h1,(v#vs,ls1,C,M,?pc1,ics)#frs,sh1)"
  have IH: "PROP ?P e h0 ls0 sh0 (Val v) h1 ls1 sh1 [] C M pc ics v xa vs frs
    (I - pcs (compxEs2 es ?pc1 (Suc (length vs))))" by fact
  then have 1: "P  0 -jvm→ 1" using Jcc_pieces_Cons[OF _ Cons1.prems(1-5)] by auto
  let ?pc2 = "?pc1 + length(compEs2 es)"
  have IHs: "PROP ?Ps es h1 ls1 sh1 fs h2 ls2 sh2 C M ?pc1 ics (tl ws) xa es' (v#vs) frs
    (I - pcs (compxE2 e pc (length vs)))" by fact
  show ?case (is "?Norm  ?Err")
  proof
    show ?Norm (is "?val  ?trans")
    proof
      assume val: ?val
      note 1
      also have "P  1 -jvm→ (None,h2,(rev(ws) @ vs,ls2,C,M,?pc2,ics)#frs,sh2)"
        using val IHs Cons1.prems by fastforce
      finally show ?trans by(simp add:add.assoc)
    qed
  next
    show ?Err (is "?throw  (pc2. ?H pc2)")
    proof
      assume throw: ?throw
      then obtain pc2 vs' where
        pc2: "?pc1  pc2  pc2 < ?pc2 
              ¬ caught P pc2 h2 xa (compxEs2 es ?pc1 (size vs + 1))" and
        2: "P  1 -jvm→ handle P C M xa h2 (vs'@v#vs) ls2 pc2 ics frs sh2"
        using IHs Cons1.prems by(fastforce simp:Cons_eq_append_conv neq_Nil_conv)
      have "?H pc2" using Cons1.prems pc2 jvm_trans[OF 1 2] by(auto intro!: exI[where x="vs'@[v]"])
      thus "pc2. ?H pc2" by iprover
    qed
  qed
next
  case (ConsThrow1 e h0 ls0 sh0 a h1 ls1 sh1 es)
  then show ?case using Jcc_pieces_Cons[OF _ ConsThrow1.prems(1-5)]
    by (fastforce simp:Cons_eq_append_conv)
next
  case InitFinal1 then show ?case using eval1_final_same[OF InitFinal1.hyps(1)] by clarsimp
next
  case (InitNone1 sh C0 C' Cs e h l e' h' l' sh')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa
     (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
    using InitNone1.prems(1) by clarsimp
  let ?sh = "(sh(C0  (sblank P1 C0, Prepared)))"
  obtain ics: "ics_of(hd frs') = Calling C0 Cs"
     and frs1: "frs'  Nil" using pcs by clarsimp
  then have 1: "P  (None,h,frs',sh) -jvm→ (None,h,frs',?sh)"
    using InitNone1 jvm_InitNone[where P = P] by(cases frs', simp+)
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      note 1
      also have "P  (None,h,frs',?sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
        using InitNone1.hyps(3)[of E] Jcc_pieces_InitNone[OF assms(1) pcs] InitNone1.prems val
         by clarsimp
      finally have ?jvm1 using pcs by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      note 1
      also obtain vs' where "P  (None,h,frs',?sh)
                     -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
        using InitNone1.hyps(3)[of E] Jcc_pieces_InitNone[OF assms(1) pcs] throw
         by clarsimp presburger
      finally have ?err using pcs by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (InitDone1 sh C0 sfs C' Cs e h l e' h' l' sh')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa
     (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
    using InitDone1.prems(1) by clarsimp
  let ?frs' = "(calling_to_scalled (hd frs'))#(tl frs')"
  have IH: "PROP ?P (INIT C' (Cs,True)  e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I"
    by fact
  obtain ics: "ics_of(hd frs') = Calling C0 Cs"
     and frs1: "frs'  Nil" using pcs by clarsimp
  then have 1: "P  (None,h,frs',sh) -jvm→ (None,h,?frs',sh)"
    using InitDone1 jvm_InitDP[where P = P] by(cases frs', simp+)
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      note 1
      also have "P  (None,h,?frs',sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
        using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitDone1.prems val by clarsimp
      finally have ?jvm1 using pcs by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      note 1
      also obtain vs' where "P  (None,h,?frs',sh)
                     -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
        using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitDone1.prems throw by clarsimp
      finally have ?err using pcs by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (InitProcessing1 sh C0 sfs C' Cs e h l e' h' l' sh')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa
     (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
    using InitProcessing1.prems(1) by clarsimp
  let ?frs' = "(calling_to_scalled (hd frs'))#(tl frs')"
  have IH: "PROP ?P (INIT C' (Cs,True)  e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I"
    by fact
  obtain ics: "ics_of(hd frs') = Calling C0 Cs"
     and frs1: "frs'  Nil" using pcs by clarsimp
  then have 1: "P  (None,h,frs',sh) -jvm→ (None,h,?frs',sh)"
    using InitProcessing1 jvm_InitDP[where P = P] by(cases frs', simp+)
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      note 1
      also have "P  (None,h,?frs',sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
        using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitProcessing1.prems val by clarsimp
      finally have ?jvm1 using pcs by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      note 1
      also obtain vs' where "P  (None,h,?frs',sh)
                     -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
        using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitProcessing1.prems throw by clarsimp
      finally have ?err using pcs by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (InitError1 sh C0 sfs Cs e h l e' h' l' sh' C')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa
     (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
    using InitError1.prems(1) by clarsimp
  let ?e0 = "THROW NoClassDefFoundError"
  let ?frs' = "(calling_to_sthrowing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs')"
  have IH: "PROP ?P (RI (C0,?e0) ; Cs  e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I" by fact
  obtain ics: "ics_of(hd frs') = Calling C0 Cs"
     and frs1: "frs'  Nil"
     and tl: "tl frs' = frs" using pcs by clarsimp
  then have 1: "P  (None,h,frs',sh) -jvm→ (None,h,?frs',sh)"
  proof(cases frs')
    case (Cons a list)
    obtain vs' l' C' M' pc' ics' where a: "a = (vs',l',C',M',pc',ics')" by(cases a)
    then have "ics' = Calling C0 Cs" using Cons ics by simp
    then show ?thesis
     using Cons a IH InitError1.prems jvm_InitError[where P = P] InitError1.hyps(1) by simp
  qed(simp)
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      then have False using val rinit1_throw[OF InitError1.hyps(2)] by blast
      then have ?jvm1 using pcs by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      let ?frs = "(calling_to_throwing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs')"
      have exec: "exec (P, (None,h,?frs,sh)) = Some (None,h,?frs',sh)"
        using exec_ErrorThrowing[where sh=sh, OF InitError1.hyps(1)] ics by(cases "hd frs'", simp)
      obtain vs' where 2: "P  (None,h,?frs,sh) -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
        using IH Jcc_pieces_InitError[OF assms(1) pcs InitError1.hyps(1)] throw by clarsimp
      have neq: "(None, h, ?frs, sh)  handle P C M xa h' (vs' @ vs) l pc ics frs sh'"
        using tl ics by(cases "hd frs'", simp add: handle_frs_tl_neq)

      note 1
      also have "P  (None,h,?frs',sh) -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
        using exec_1_exec_all_conf[OF exec 2] neq by simp
      finally have ?err using pcs by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (InitObject1 sh C0 sfs sh' C' Cs e h l e' h' l' sh'')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l'
    (sh(C0  (sfs, Processing))) v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
    using InitObject1.prems(1) by clarsimp
  let ?frs' = "(calling_to_called (hd frs'))#(tl frs')"
  have IH: "PROP ?P (INIT C' (C0#Cs,True)  e) h l sh' e' h' l' sh'' E C M pc ics v xa vs frs I"
    by fact
  obtain ics: "ics_of(hd frs') = Calling C0 Cs"
     and frs1: "frs'  Nil" using pcs by clarsimp
  then have 1: "P  (None,h,frs',sh) -jvm→ (None,h,?frs',sh')"
  proof(cases frs')
    case (Cons a list)
    obtain vs' l' C' M' pc' ics' where a: "a = (vs',l',C',M',pc',ics')" by(cases a)
    then have "ics' = Calling C0 Cs" using Cons ics by simp
    then show ?thesis
     using Cons Nil a IH InitObject1 jvm_InitObj[where P = P] by simp
  qed(simp)
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      note 1
      also have "P  (None,h,?frs',sh') -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh'')"
        using IH Jcc_pieces_InitObj[OF assms(1) pcs] InitObject1 val by simp
      finally have ?jvm1 using pcs by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      note 1
      also obtain vs' where "P  (None,h,?frs',sh')
                     -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh''"
        using IH Jcc_pieces_InitObj[OF assms(1) pcs] InitObject1 throw by clarsimp
      finally have ?err using pcs by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (InitNonObject1 sh C0 sfs D a b sh' C' Cs e h l e' h' l' sh'')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l'
    (sh(C0  (sfs,Processing))) v xa (INIT C' (C0 # Cs,False)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
    using InitNonObject1.prems(1) by clarsimp
  let ?frs' = "(calling_to_calling (hd frs') D)#(tl frs')"
  have cls1: "is_class P1 D" using InitNonObject1.hyps(2,3) class_wf wf wf_cdecl_supD by blast
  have cls_aux: "distinct (C0#Cs)  supercls_lst P1 (C0#Cs)" using InitNonObject1.prems(1) by auto
  then have cls2: "D  set (C0 # Cs)"
  proof -
    have "distinct (D # C0 # Cs)"
      using InitNonObject1.hyps(2,3) cls_aux wf wf_supercls_distinct_app by blast
    then show "D  set (C0 # Cs)"
      by (metis distinct.simps(2))
  qed
  have cls3: "Cset (C0 # Cs). P1  C * D" using InitNonObject1.hyps(2,3) cls_aux
    by (metis r_into_rtrancl rtrancl_into_rtrancl set_ConsD subcls1.subcls1I supercls_lst.simps(1))
  have IH: "PROP ?P (INIT C' (D # C0 # Cs,False)  e) h l sh' e' h' l' sh'' E C M pc ics v xa vs frs I"
    by fact
  obtain r where cls: "class P C0 = (D, r)" using InitNonObject1.hyps(3)
    by (metis assms class_compP compP2_def)
  obtain ics: "ics_of(hd frs') = Calling C0 Cs"
     and frs1: "frs'  Nil" using pcs by clarsimp
  then have 1: "P  (None,h,frs',sh) -jvm→ (None,h,?frs',sh')"
  proof(cases frs')
    case (Cons a list)
    obtain vs' l' C' M' pc' ics' where a: "a = (vs',l',C',M',pc',ics')" by(cases a)
    then have "ics' = Calling C0 Cs" using Cons ics by simp
    then show ?thesis
     using Cons a IH InitNonObject1 jvm_InitNonObj[OF _ _ cls] by simp
  qed(simp)
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      note 1
      also have "P  (None,h,?frs',sh') -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh'')"
        using IH Jcc_pieces_InitNonObj[OF assms(1) cls1 cls2 cls3 pcs] InitNonObject1 val by simp
      finally have ?jvm1 using pcs by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      note 1
      also obtain vs' where "P  (None,h,?frs',sh')
                     -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh''"
        using IH Jcc_pieces_InitNonObj[OF assms(1) cls1 cls2 cls3 pcs] InitNonObject1 throw by clarsimp
      finally have ?err using pcs by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (InitRInit1 C0 Cs e h l sh e' h' l' sh' C')
  then obtain frs' err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh' v xa
     (INIT C' (C0 # Cs,True)  e)
    = (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
    using InitRInit1.prems(1) by clarsimp
  have IH: "PROP ?P (RI (C0,C0sclinit([])) ; Cs  e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I"
    by fact
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      have "P  (None,h,frs',sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
        using IH Jcc_pieces_InitRInit[OF assms(1,2) pcs] InitRInit1.prems val by simp
      then have ?jvm1 using pcs by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      obtain vs' where "P  (None,h,frs',sh)
                     -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
        using IH Jcc_pieces_InitRInit[OF assms(1,2) pcs] InitRInit1 throw by clarsimp
      then have ?err using pcs by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (RInit1 e h l sh v1 h' l' sh' C0 sfs i sh'' C' Cs e' e1 h1 l1 sh1)
  let ?frs = "(vs,l,C,M,pc,Called (C0#Cs)) # frs"
  let ?frs' = "(vs,l,C,M,pc,Called Cs) # frs"
  have clinit: "e = C0sclinit([])" using RInit1
    by (metis Jcc_cond.simps(2) eval1_final_same exp.distinct(101) final_def)
  then obtain err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h1 l1 sh1 v xa
     (RI (C0,C0sclinit([])) ; Cs  e')
    = (True, ?frs, (None, h1, (vs, l, C, M, pc, Called []) # frs, sh1), err)"
    using RInit1.prems(1) by simp
  have shC: "C'set Cs. sfs. sh C' = (sfs, Processing)" using RInit1.prems(1) clinit by clarsimp
  then have shC'': "C'set Cs. sfs. sh'' C' = (sfs, Processing)"
    using clinit1_proc_pres[OF wf] RInit1.hyps(1) clinit RInit1.hyps(4) RInit1.prems(1)
      by (auto simp: fun_upd_apply)
  have loc: "l = l'" using clinit1_loc_pres RInit1.hyps(1) clinit by simp
  have IH: "PROP ?P e h l sh (Val v1) h' l' sh' E C M pc (Called Cs) v1 xa vs (tl ?frs') I" by fact
  then have IH':
   "PROP ?P (C0sclinit([])) h l sh (Val v1) h' l' sh' E C M pc (Called Cs) v1 xa vs (tl ?frs') I"
    using clinit by simp
  have IH2: "PROP ?P (INIT C' (Cs,True)  e') h' l' sh'' e1 h1 l1 sh1 E C M
    pc ics v xa vs frs I" by fact
  have "P  (None,h,?frs,sh) -jvm→ (None,h,create_init_frame P C0 # ?frs',sh)" by(rule jvm_Called)
  also have "P   -jvm→ (None,h',?frs',sh'')"
     using IH' Jcc_pieces_RInit_clinit[OF assms(1-2) pcs,of h' l' sh'] RInit1.hyps(3,4) by simp
  finally have jvm1: "P  (None,h,?frs,sh) -jvm→ (None,h',?frs',sh'')" .
  show ?case (is "(?e1  ?jvm1)  (?e2  ?err)")
  proof(rule conjI)
    { assume val: ?e1
      note jvm1
      also have "P  (None,h',?frs',sh'') -jvm→ (None,h1,(vs,l,C,M,pc,Called [])#frs,sh1)"
        using IH2 Jcc_pieces_RInit_Init[OF assms(1-2) shC'' pcs,of h'] RInit1.hyps(5) loc val by auto
      finally have ?jvm1 using pcs clinit by simp
    }
    thus "?e1  ?jvm1" by simp
  next
    { assume throw: ?e2
      note jvm1
      also obtain vs' where "P  (None,h',?frs',sh'')
                     -jvm→ handle P C M xa h1 (vs'@vs) l pc ics frs sh1"
        using IH2 Jcc_pieces_RInit_Init[OF assms(1-2) shC'' pcs,of h'] RInit1.hyps(5) loc throw by auto
      finally have ?err using pcs clinit by auto
    }
    thus "?e2  ?err" by simp
  qed
next
  case (RInitInitFail1 e h l sh a h' l' sh' C0 sfs i sh'' D Cs e' e1 h1 l1 sh1)
  let ?frs = "(vs,l,C,M,pc,Called (C0#D#Cs)) # frs"
  let ?frs' = "(vs,l,C,M,pc,Called (D#Cs)) # frs"
  let "?frsT" = "λxa1. (vs,l,C,M,pc,Throwing (C0#D#Cs) xa1) # frs"
  let "?frsT'" = "λxa1. (vs,l,C,M,pc,Throwing (D#Cs) xa1) # frs"
  obtain xa' where xa': "throw a = Throw xa'"
    by (metis RInitInitFail1.hyps(1) eval1_final exp.distinct(101) final_def)
  have e1: "e1 = Throw xa'" using xa' rinit1_throw RInitInitFail1.hyps(5) by simp
  show ?case
  proof(cases "e = C0sclinit([])")
    case clinit: True
    then obtain err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h1 l1 sh1 v xa'
       (RI (C0,C0sclinit([])) ; D # Cs  e')
      = (True, ?frs, (None, h1, (vs, l, C, M, pc, Called []) # frs, sh1), err)"
      using RInitInitFail1.prems(1) by simp
    have loc: "l = l'" using clinit1_loc_pres RInitInitFail1.hyps(1) clinit by simp
    have IH: "PROP ?P e h l sh (throw a) h' l' sh' E C M pc (Called (D#Cs)) v xa' vs frs I"
     by fact
    then have IH':
     "PROP ?P (C0sclinit([])) h l sh (Throw xa') h' l' sh' E C M pc (Called (D#Cs)) v xa' vs
       frs I"  using clinit xa' by simp
    have IH2: "PROP ?P (RI (D,throw a) ; Cs  e') h' l' sh'' e1 h1 l1 sh1 E C M
      pc ics v xa' vs frs I" by fact
    have "P  (None,h,?frs,sh) -jvm→ (None,h,create_init_frame P C0 # ?frs',sh)" by(rule jvm_Called)
    also have "P   -jvm→ (None,h',(vs, l, C, M, pc, Throwing (D#Cs) xa') # frs,sh'')"
      using IH' Jcc_pieces_RInit_clinit[OF assms(1-2) pcs,of h' l' sh'] RInitInitFail1.hyps(3,4)
        by simp
    also obtain vs'' where "P   -jvm→ handle P C M xa' h1 (vs''@vs) l pc ics frs sh1"
      using IH2 pcs Jcc_pieces_RInit_RInit[OF assms(1) pcs] RInitInitFail1.hyps(3,4)
        xa' loc e1 xa' by clarsimp
    finally show ?thesis using pcs e1 clinit by auto
  next
    case throw: False
    then have eT: "e = Throw xa'" "h = h'" "l = l'" "sh = sh'" using xa' RInitInitFail1.prems(1)
      eval1_final_same[OF RInitInitFail1.hyps(1)] by clarsimp+
    obtain a' where "class P1 C0 = a'" using RInitInitFail1.prems by(auto simp: is_class_def)
    then obtain stk' loc' M' pc' ics' where "create_init_frame P C0 = (stk',loc',C0,M',pc',ics')"
      using create_init_frame_wf_eq[OF wf] by(cases "create_init_frame P C0", simp)
    then obtain rhs err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh'' v xa'
       (RI (C0,e) ; D#Cs  e') = (True, ?frsT xa', rhs, err)"
      using RInitInitFail1.prems(1) eT by clarsimp
    have IH2: "PROP ?P (RI (D,throw a) ; Cs  e') h' l' sh'' e1 h1 l1 sh1 E C M
      pc ics v xa' vs frs I" by fact
    have "P  (None,h,?frsT xa',sh') -jvm→ (None,h,?frsT' xa',sh'(C0  (fst (the (sh' C0)), Error)))"
      by(rule jvm_Throwing)
    also obtain vs' where "P  ... -jvm→ handle P C M xa' h1 (vs'@vs) l pc ics frs sh1"
      using IH2 Jcc_pieces_RInit_RInit[OF assms(1) pcs] RInitInitFail1.hyps(3,4)
       eT e1 xa' by clarsimp
    finally show ?thesis using pcs e1 throw eT by auto
  qed
next
  case (RInitFailFinal1 e h l sh a h' l' sh' C0 sfs i sh'' e'')
  let ?frs = "(vs,l,C,M,pc,Called [C0]) # frs"
  let ?frs' = "(vs,l,C,M,pc,Called []) # frs"
  let "?frsT" = "λxa1. (vs,l,C,M,pc,Throwing [C0] xa1) # frs"
  let "?frsT'" = "λxa1. (vs,l,C,M,pc,Throwing [] xa1) # frs"
  obtain xa' where xa': "throw a = Throw xa'"
    by (metis RInitFailFinal1.hyps(1) eval1_final exp.distinct(101) final_def)
  show ?case
  proof(cases "e = C0sclinit([])")
    case clinit: True
    then obtain err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh'' v xa'
       (RI (C0,C0sclinit([])) ; []  unit) = (True, ?frs, (None, h', ?frs', sh''), err)"
      using RInitFailFinal1.prems(1) by clarsimp
    have IH: "PROP ?P e h l sh (throw a) h' l' sh' E C M pc (Called []) v xa' vs frs I" by fact
    then have IH':
     "PROP ?P (C0sclinit([])) h l sh (throw a) h' l' sh' E C M pc (Called []) v xa' vs frs I"
      using clinit by simp
    have "P  (None,h,?frs,sh) -jvm→ (None,h,create_init_frame P C0 # ?frs',sh)"
      by(rule jvm_Called)
    also have "P   -jvm→ (None,h',?frsT' xa',sh'')"
      using IH' Jcc_pieces_RInit_clinit[OF assms(1-2) pcs,of h' l' sh'] xa'
        RInitFailFinal1.hyps(3,4) by simp
    also have
       "P   -jvm→ handle (compP compMb2 P1) C M xa' h' vs l pc No_ics frs sh''"
      using RInitFailFinal1.hyps(3,4) jvm_RInit_throw[where h=h' and sh=sh''] by simp
    finally show ?thesis using xa' pcs clinit by(clarsimp intro!: exI[where x="[]"])
  next
    case throw: False
    then have eT: "e = Throw xa'" "h = h'" "sh = sh'" using xa' RInitFailFinal1.prems(1)
      eval1_final_same[OF RInitFailFinal1.hyps(1)] by clarsimp+
    obtain a where "class P1 C0 = a" using RInitFailFinal1.prems by(auto simp: is_class_def)
    then obtain stk' loc' M' pc' ics' where "create_init_frame P C0 = (stk',loc',C0,M',pc',ics')"
      using create_init_frame_wf_eq[OF wf] by(cases "create_init_frame P C0", simp)
    then obtain rhs err where pcs: "Jcc_pieces P1 E C M h vs l pc ics frs sh I h' l' sh'' v xa'
       (RI (C0,e) ; []  unit) = (True, ?frsT xa', rhs, err)"
      using RInitFailFinal1.prems(1) eT by clarsimp
    have "P  (None,h,?frsT xa',sh) -jvm→ (None,h,?frsT' xa',sh(C0  (fst (the (sh C0)), Error)))"
      by(rule jvm_Throwing)
    also have "P   -jvm→ handle P C M xa' h' vs l pc No_ics frs sh''"
      using RInitFailFinal1.hyps(3,4) jvm_RInit_throw[where h=h and sh=sh''] eT by simp
    finally show ?thesis using pcs xa' by(clarsimp intro!: exI[where x="[]"])
  qed
qed
(*>*)

(*FIXME move! *)
lemma atLeast0AtMost[simp]: "{0::nat..n} = {..n}"
by auto

lemma atLeast0LessThan[simp]: "{0::nat..<n} = {..<n}"
by auto

fun exception :: "'a exp  addr option" where
  "exception (Throw a) = Some a"
| "exception e = None"

lemma comp2_correct:
assumes wf: "wf_J1_prog P1"
    and "method": "P1  C sees M,b:TsT = body in C"
    and eval:   "P1 1 body,(h,ls,sh)  e',(h',ls',sh')"
    and nclinit: "M  clinit"
shows "compP2 P1  (None,h,[([],ls,C,M,0,No_ics)],sh) -jvm→ (exception e',h',[],sh')"
(*<*)
      (is "_  0 -jvm→ 1")
proof -
  let ?P = "compP2 P1"
  let ?E = "case b of Static  Ts | NonStatic  Class C#Ts"
  have nsub: "¬sub_RI body" using sees_wf1_nsub_RI[OF wf method] by simp
  have code: "?P,C,M,0  compE2 body" using beforeM[OF "method"] by auto
  have xtab: "?P,C,M  compxE2 body 0 (size[])/{..<size(compE2 body)},size[]"
    using beforexM[OF "method"] by auto
  have cond: "Jcc_cond P1 ?E C M [] 0 No_ics {..<size(compE2 body)} h sh body"
    using nsub_RI_Jcc_pieces nsub code xtab by auto
  ― ‹Distinguish if e' is a value or an exception›
  { fix v assume [simp]: "e' = Val v"
    have "?P  0 -jvm→ (None,h',[([v],ls',C,M,size(compE2 body),No_ics)],sh')"
      using Jcc[OF wf eval cond] nsub_RI_Jcc_pieces[OF _ nsub] by auto
    also have "?P   -jvm→ 1" using beforeM[OF "method"] nclinit by auto
    finally have ?thesis .
  }
  moreover
  { fix a assume [simp]: "e' = Throw a"
    obtain pc vs' where pc: "0  pc  pc < size(compE2 body) 
          ¬ caught ?P pc h' a (compxE2 body 0 0)"
    and 1: "?P  0 -jvm→ handle ?P C M a h' vs' ls' pc No_ics [] sh'"
      using Jcc[OF wf eval cond] nsub_RI_Jcc_pieces[OF _ nsub] by auto meson
    from pc have "handle ?P C M a h' vs' ls' pc No_ics [] sh' = 1" using xtab "method" nclinit
      by(auto simp:handle_def compMb2_def)
    with 1 have ?thesis by simp
  } 
  ultimately show ?thesis using eval1_final[OF eval] by(auto simp:final_def)
qed
(*>*)

end

Theory Compiler

(*  Title:      JinjaDCI/Compiler/Compiler.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Compiler/Compiler.thy by Tobias Nipkow
*)

section ‹ Combining Stages 1 and 2 ›

theory Compiler
imports Correctness1 Correctness2
begin

definition J2JVM :: "J_prog  jvm_prog"
where 
  "J2JVM    compP2  compP1"

theorem comp_correct_NonStatic:
assumes wf: "wf_J_prog P"
and "method": "P  C sees M,NonStatic:TsT = (pns,body) in C"
and eval: "P  body,(h,[this#pns [↦] vs],sh)  e',(h',l',sh')"
and sizes: "size vs = size pns + 1"    "size rest = max_vars body"
shows "J2JVM P  (None,h,[([],vs@rest,C,M,0,No_ics)],sh) -jvm→ (exception e',h',[],sh')"
(*<*)
proof -
  let ?P1 = "compP1 P"
  have nclinit: "M  clinit" using wf_sees_clinit1[OF wf] visible_method_exists[OF "method"]
    sees_method_idemp[OF "method"] by fastforce
  have wf1: "wf_J1_prog ?P1" by(rule compP1_pres_wf[OF wf])
  have fv: "fv body  set (this#pns)"
    using wf_prog_wwf_prog[OF wf] "method" by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have init: "[this#pns [↦] vs] m [this#pns [↦] vs@rest]"
    using sizes by simp
  have "?P1  C sees M,NonStatic: TsT = (compE1 (this#pns) body) in C"
    using sees_method_compP[OF "method", of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  moreover obtain ls' where
    "?P1 1 compE1 (this#pns) body, (h, vs@rest, sh)  fin1 e', (h',ls', sh')"
    using eval1_eval[OF wf_prog_wwf_prog[OF wf] eval fv init] sizes by auto
  ultimately show ?thesis using comp2_correct[OF wf1] eval_final[OF eval] nclinit
    by(fastforce simp add:J2JVM_def final_def)
qed
(*>*)

theorem comp_correct_Static:
assumes wf: "wf_J_prog P"
and "method": "P  C sees M,Static:TsT = (pns,body) in C"
and eval: "P  body,(h,[pns [↦] vs],sh)  e',(h',l',sh')"
and sizes: "size vs = size pns"    "size rest = max_vars body"
and nclinit: "M  clinit"
shows "J2JVM P  (None,h,[([],vs@rest,C,M,0,No_ics)],sh) -jvm→ (exception e',h',[],sh')"
(*<*)
proof -
  let ?P1 = "compP1 P"
  have wf1: "wf_J1_prog ?P1" by(rule compP1_pres_wf[OF wf])
  have fv: "fv body  set pns"
    using wf_prog_wwf_prog[OF wf] "method" by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have init: "[pns [↦] vs] m [pns [↦] vs@rest]"
    using sizes by simp
  have "?P1  C sees M,Static: TsT = (compE1 pns body) in C"
    using sees_method_compP[OF "method", of "λb (pns,e). compE1 (case b of NonStatic  this#pns | Static  pns) e"]
    by(simp)
  moreover obtain ls' where
    "?P1 1 compE1 pns body, (h, vs@rest, sh)  fin1 e', (h',ls', sh')"
    using eval1_eval[OF wf_prog_wwf_prog[OF wf] eval fv init] sizes by auto
  ultimately show ?thesis using comp2_correct[OF wf1] eval_final[OF eval] nclinit
    by(fastforce simp add:J2JVM_def final_def)
qed
(*>*)

end

Theory TypeComp

(*  Title:      JinjaDCI/Compiler/TypeComp.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Compiler/TypeComp.thy by Tobias Nipkow
*)

section ‹ Preservation of Well-Typedness ›

theory TypeComp
imports Compiler "../BV/BVSpec"
begin

(*<*)
declare nth_append[simp]
(*>*)

lemma max_stack1: "P,E 1 e :: T  1  max_stack e"
(*<*)using max_stack1'[OF WT1_nsub_RI] by simp(*>*)

locale TC0 =
  fixes P :: "J1_prog" and mxl :: nat
begin

definition "ty E e = (THE T. P,E 1 e :: T)"

definition "tyl E A' = map (λi. if i  A'  i < size E then OK(E!i) else Err) [0..<mxl]"

definition "tyi' ST E A = (case A of None  None | A'  Some(ST, tyl E A'))"

definition "after E A ST e = tyi' (ty E e # ST) E (A  𝒜 e)"

end

lemma (in TC0) ty_def2 [simp]: "P,E 1 e :: T  ty E e = T"
(*<*)
apply (unfold ty_def)
apply(blast intro: the_equality WT1_unique)
done
(*>*)

lemma (in TC0) [simp]: "tyi' ST E None = None"
(*<*)by (simp add: tyi'_def)(*>*)

lemma (in TC0) tyl_app_diff[simp]:
 "tyl (E@[T]) (A - {size E}) = tyl E A"
(*<*)by(auto simp add:tyl_def hyperset_defs)(*>*)


lemma (in TC0) tyi'_app_diff[simp]:
 "tyi' ST (E @ [T]) (A  size E) = tyi' ST E A"
(*<*)by(auto simp add:tyi'_def hyperset_defs)(*>*)


lemma (in TC0) tyl_antimono:
 "A  A'  P  tyl E A' [≤] tyl E A"
(*<*)by(auto simp:tyl_def list_all2_conv_all_nth)(*>*)


lemma (in TC0) tyi'_antimono:
 "A  A'  P  tyi' ST E A' ≤' tyi' ST E A"
(*<*)by(auto simp:tyi'_def tyl_def list_all2_conv_all_nth)(*>*)


lemma (in TC0) tyl_env_antimono:
 "P  tyl (E@[T]) A [≤] tyl E A" 
(*<*)by(auto simp:tyl_def list_all2_conv_all_nth)(*>*)


lemma (in TC0) tyi'_env_antimono:
 "P  tyi' ST (E@[T]) A ≤' tyi' ST E A" 
(*<*)by(auto simp:tyi'_def tyl_def list_all2_conv_all_nth)(*>*)


lemma (in TC0) tyi'_incr:
 "P  tyi' ST (E @ [T]) insert (size E) A ≤' tyi' ST E A"
(*<*)by(auto simp:tyi'_def tyl_def list_all2_conv_all_nth)(*>*)


lemma (in TC0) tyl_incr:
 "P  tyl (E @ [T]) (insert (size E) A) [≤] tyl E A"
(*<*)by(auto simp: hyperset_defs tyl_def list_all2_conv_all_nth)(*>*)


lemma (in TC0) tyl_in_types:
 "set E  types P  tyl E A  list mxl (err (types P))"
(*<*)by(auto simp add:tyl_def intro!:listI dest!: nth_mem)(*>*)

locale TC1 = TC0
begin

primrec compT :: "ty list  nat hyperset  ty list  expr1  tyi' list" and
   compTs :: "ty list  nat hyperset  ty list  expr1 list  tyi' list" where
"compT E A ST (new C) = []"
| "compT E A ST (Cast C e) =  
   compT E A ST e @ [after E A ST e]"
| "compT E A ST (Val v) = []"
| "compT E A ST (e1 «bop» e2) =
  (let ST1 = ty E e1#ST; A1 = A  𝒜 e1 in
   compT E A ST e1 @ [after E A ST e1] @
   compT E A1 ST1 e2 @ [after E A1 ST1 e2])"
| "compT E A ST (Var i) = []"
| "compT E A ST (i := e) = compT E A ST e @
   [after E A ST e, tyi' ST E (A  𝒜 e  {i})]"
| "compT E A ST (eF{D}) = 
   compT E A ST e @ [after E A ST e]"
| "compT E A ST (CsF{D}) = []"
| "compT E A ST (e1F{D} := e2) =
  (let ST1 = ty   E e1#ST; A1 = A  𝒜 e1; A2 = A1  𝒜 e2 in
   compT E A ST e1 @ [after E A ST e1] @
   compT E A1 ST1 e2 @ [after E A1 ST1 e2] @
   [tyi' ST E A2])"
| "compT E A ST (CsF{D} := e2) = compT E A ST e2 @ [after E A ST e2] @ [tyi' ST E (A  𝒜 e2)]"
| "compT E A ST {i:T; e} = compT (E@[T]) (Ai) ST e"
| "compT E A ST (e1;;e2) =
  (let A1 = A  𝒜 e1 in
   compT E A ST e1 @ [after E A ST e1, tyi' ST E A1] @
   compT E A1 ST e2)"
| "compT E A ST (if (e) e1 else e2) =
   (let A0 = A  𝒜 e; τ = tyi' ST E A0 in
    compT E A ST e @ [after E A ST e, τ] @
    compT E A0 ST e1 @ [after E A0 ST e1, τ] @
    compT E A0 ST e2)"
| "compT E A ST (while (e) c) =
   (let A0 = A  𝒜 e;  A1 = A0  𝒜 c; τ = tyi' ST E A0 in
    compT E A ST e @ [after E A ST e, τ] @
    compT E A0 ST c @ [after E A0 ST c, tyi' ST E A1, tyi' ST E A0])"
| "compT E A ST (throw e) = compT E A ST e @ [after E A ST e]"
| "compT E A ST (eM(es)) =
   compT E A ST e @ [after E A ST e] @
   compTs E (A  𝒜 e) (ty   E e # ST) es"
| "compT E A ST (CsM(es)) = compTs E A ST es"
| "compT E A ST (try e1 catch(C i) e2) =
   compT E A ST e1 @ [after E A ST e1] @
   [tyi' (Class C#ST) E A, tyi' ST (E@[Class C]) (A  {i})] @
   compT (E@[Class C]) (A  {i}) ST e2"
| "compT E A ST (INIT C (Cs,b)  e) = []"
| "compT E A ST (RI(C,e');Cs  e) = []"
| "compTs E A ST [] = []"
| "compTs  E A ST (e#es) = compT E A ST e @ [after E A ST e] @
                            compTs E (A  (𝒜 e)) (ty E e # ST) es"

definition compTa :: "ty list  nat hyperset  ty list  expr1  tyi' list" where
  "compTa E A ST e = compT E A ST e @ [after E A ST e]"

end

lemma compE2_not_Nil[simp]: "P,E 1 e :: T  compE2 e  []"
(*<*)by(simp add: compE2_not_Nil' WT1_nsub_RI)(*>*)

lemma (in TC1) compT_sizes':
shows "E A ST. ¬sub_RI e  size(compT E A ST e) = size(compE2 e) - 1"
and "E A ST. ¬sub_RIs es  size(compTs E A ST es) = size(compEs2 es)"
(*<*)
apply(induct e and es rule: compE2.induct compEs2.induct)
apply(auto split:bop.splits nat_diff_split simp: compE2_not_Nil')
done
(*>*)

lemma (in TC1) compT_sizes[simp]:
shows "E A ST. P,E 1 e :: T  size(compT E A ST e) = size(compE2 e) - 1"
and "E A ST. P,E 1 es [::] Ts  size(compTs E A ST es) = size(compEs2 es)"
(*<*)using compT_sizes' WT1_nsub_RI WTs1_nsub_RIs by auto(*>*)


lemma (in TC1) [simp]: "ST E. τ  set (compT E None ST e)"
and [simp]: "ST E. τ  set (compTs E None ST es)"
(*<*)by(induct e and es rule: compT.induct compTs.induct) (simp_all add:after_def)(*>*)


lemma (in TC0) pair_eq_tyi'_conv:
  "((ST, LT) = tyi' ST0 E A) =
  (case A of None  False | Some A  (ST = ST0  LT = tyl E A))"
(*<*)by(simp add:tyi'_def)(*>*)


lemma (in TC0) pair_conv_tyi':
  "(ST, tyl E A) = tyi' ST E A"
(*<*)by(simp add:tyi'_def)(*>*)

(*<*)
declare (in TC0)
  tyi'_antimono [intro!] after_def[simp]
  pair_conv_tyi'[simp] pair_eq_tyi'_conv[simp]
(*>*)


lemma (in TC1) compT_LT_prefix:
 "E A ST0.  (ST,LT)  set(compT E A ST0 e);e (size E) 
                P  (ST,LT) ≤' tyi' ST E A"
and
 "E A ST0.  (ST,LT)  set(compTs E A ST0 es); ℬs es (size E) 
                P  (ST,LT) ≤' tyi' ST E A"
(*<*)
proof(induct e and es rule: compT.induct compTs.induct)
  case FAss thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
  case BinOp thus ?case
    by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans split:bop.splits)
next
  case Seq thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
  case While thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
  case Cond thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
  case Block thus ?case
    by(force simp add:hyperset_defs tyi'_def simp del:pair_conv_tyi'
             elim!:sup_state_opt_trans)
next
  case Call thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
  case Cons_exp thus ?case
    by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
  case TryCatch thus ?case
    by(fastforce simp:hyperset_defs intro!: tyi'_incr
                elim!:sup_state_opt_trans)
qed (auto simp:hyperset_defs)

declare (in TC0)
  tyi'_antimono [rule del] after_def[simp del]
  pair_conv_tyi'[simp del] pair_eq_tyi'_conv[simp del]
(*>*)


lemma [iff]: "OK None  states P mxs mxl"
(*<*)by(simp add: JVM_states_unfold)(*>*)

lemma (in TC0) after_in_states:
 " wf_prog p P; P,E 1 e :: T; set E  types P; set ST  types P;
    size ST + max_stack e  mxs 
  OK (after E A ST e)  states P mxs mxl"
(*<*)
apply(subgoal_tac "size ST + 1  mxs")
 apply(simp add: after_def tyi'_def JVM_states_unfold tyl_in_types)
 apply(blast intro!:listI WT1_is_type)
using max_stack1[where e=e] apply fastforce
done
(*>*)


lemma (in TC0) OK_tyi'_in_statesI[simp]:
  " set E  types P; set ST  types P; size ST  mxs 
   OK (tyi' ST E A)  states P mxs mxl"
(*<*)
apply(simp add:tyi'_def JVM_states_unfold tyl_in_types)
apply(blast intro!:listI)
done
(*>*)


lemma is_class_type_aux: "is_class P C  is_type P (Class C)"
(*<*)by(simp)(*>*)

(*<*)
declare is_type_simps[simp del] subsetI[rule del]
(*>*)

theorem (in TC1) compT_states:
assumes wf: "wf_prog p P"
shows "E T A ST.
   P,E 1 e :: T; set E  types P; set ST  types P;
    size ST + max_stack e  mxs; size E + max_vars e  mxl 
   OK ` set(compT E A ST e)  states P mxs mxl"
(*<*)(is "E T A ST. PROP ?P e E T A ST")(*>*)

and "E Ts A ST.
   P,E 1 es[::]Ts;  set E  types P; set ST  types P;
    size ST + max_stacks es  mxs; size E + max_varss es  mxl 
   OK ` set(compTs E A ST es)  states P mxs mxl"
(*<*)(is "E Ts A ST. PROP ?Ps es E Ts A ST")
proof(induct e and es rule: compT.induct compTs.induct)
  case new thus ?case by(simp)
next
  case (Cast C e) thus ?case by (auto simp:after_in_states[OF wf])
next
  case Val thus  ?case by(simp)
next
  case Var thus ?case by(simp)
next
  case LAss thus ?case  by(auto simp:after_in_states[OF wf])
next
  case FAcc thus ?case by(auto simp:after_in_states[OF wf])
next
  case SFAcc thus ?case by(auto simp:after_in_states[OF wf])
next
  case FAss thus ?case
    by(auto simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf])
next
  case SFAss thus ?case
    by(auto simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf])
next
  case Seq thus ?case
    by(auto simp:image_Un after_in_states[OF wf])
next
  case BinOp thus ?case
    by(auto simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf])
next
  case Cond thus ?case
    by(force simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf])
next
  case While thus ?case
    by(auto simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf])
next
  case Block thus ?case by(auto)
next
  case (TryCatch e1 C i e2)
  moreover have "size ST + 1  mxs"
   using TryCatch.prems max_stack1[where e=e1] by fastforce
  ultimately show ?case  
    by(auto simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf]
                  is_class_type_aux)
next
  case Nil_exp thus ?case by simp
next
  case Cons_exp thus ?case
    by(auto simp:image_Un  WT1_is_type[OF wf] after_in_states[OF wf])
next
  case throw thus ?case
    by(auto simp: WT1_is_type[OF wf] after_in_states[OF wf])
next
  case Call thus ?case
    by(auto simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf])
next
  case SCall thus ?case
    by(auto simp:image_Un WT1_is_type[OF wf] after_in_states[OF wf])
next
  case INIT thus ?case by simp
next
  case RI thus ?case by simp
qed

declare is_type_simps[simp] subsetI[intro!]
(*>*)


definition shift :: "nat  ex_table  ex_table"
where
  "shift n xt  map (λ(from,to,C,handler,depth). (from+n,to+n,C,handler+n,depth)) xt"


lemma [simp]: "shift 0 xt = xt"
(*<*)by(induct xt)(auto simp:shift_def)(*>*)

lemma [simp]: "shift n [] = []"
(*<*)by(simp add:shift_def)(*>*)

lemma [simp]: "shift n (xt1 @ xt2) = shift n xt1 @ shift n xt2"
(*<*)by(simp add:shift_def)(*>*)

lemma [simp]: "shift m (shift n xt) = shift (m+n) xt"
(*<*)by(induct xt)(auto simp:shift_def)(*>*)

lemma [simp]: "pcs (shift n xt) = {pc+n|pc. pc  pcs xt}"
(*<*)
apply(auto simp:shift_def pcs_def)
apply(rule_tac x = "x-n" in exI)
apply (force split:nat_diff_split)
done
(*>*)


lemma shift_compxE2:
shows "pc pc' d. shift pc (compxE2 e pc' d) = compxE2 e (pc' + pc) d"
and  "pc pc' d. shift pc (compxEs2 es pc' d) = compxEs2 es (pc' + pc) d"
(*<*)
apply(induct e and es rule: compxE2.induct compxEs2.induct)
apply(auto simp:shift_def ac_simps)
done
(*>*)


lemma compxE2_size_convs[simp]:
shows "n  0  compxE2 e n d = shift n (compxE2 e 0 d)"
and "n  0  compxEs2 es n d = shift n (compxEs2 es 0 d)"
(*<*)by(simp_all add:shift_compxE2)(*>*)

locale TC2 = TC1 +
  fixes Tr :: ty and mxs :: pc
begin

definition
  wt_instrs :: "instr list  ex_table  tyi' list  bool"
    ("( _, _ /[::]/ _)" [0,0,51] 50) where
  " is,xt [::] τs  size is < size τs  pcs xt  {0..<size is} 
  (pc< size is. P,Tr,mxs,size τs,xt  is!pc,pc :: τs)"

end

notation TC2.wt_instrs ("(_,_,_ / _, _ /[::]/ _)" [50,50,50,50,50,51] 50)

(*<*)
lemmas (in TC2) wt_defs =
  wt_instrs_def wt_instr_def app_def eff_def norm_eff_def
(*>*)

lemma (in TC2) [simp]: "τs  []   [],[] [::] τs"
(*<*) by (simp add: wt_defs) (*>*)

lemma [simp]: "eff i P pc et None = []"
(*<*)by (simp add: Effect.eff_def)(*>*)

(*<*)
declare split_comp_eq[simp del]
(*>*)

lemma wt_instr_appR:
 " P,T,m,mpc,xt  is!pc,pc :: τs;
    pc < size is; size is < size τs; mpc  size τs; mpc  mpc' 
   P,T,m,mpc',xt  is!pc,pc :: τs@τs'"
(*<*)by (fastforce simp:wt_instr_def app_def)(*>*)


lemma relevant_entries_shift [simp]:
  "relevant_entries P i (pc+n) (shift n xt) = shift n (relevant_entries P i pc xt)"
(*<*)
  apply (induct xt)
  apply (unfold relevant_entries_def shift_def)
   apply simp
  apply (auto simp add: is_relevant_entry_def)
  done
(*>*)


lemma [simp]:
  "xcpt_eff i P (pc+n) τ (shift n xt) =
   map (λ(pc,τ). (pc + n, τ)) (xcpt_eff i P pc τ xt)"
(*<*)
apply(simp add: xcpt_eff_def)
apply(cases τ)
apply(auto simp add: shift_def)
done
(*>*)


lemma  [simp]:
  "appi (i, P, pc, m, T, τ) 
   eff i P (pc+n) (shift n xt) (Some τ) =
   map (λ(pc,τ). (pc+n,τ)) (eff i P pc xt (Some τ))"
(*<*)
apply(simp add:eff_def norm_eff_def)
apply(cases "i",auto)
done
(*>*)


lemma [simp]:
  "xcpt_app i P (pc+n) mxs (shift n xt) τ = xcpt_app i P pc mxs xt τ"
(*<*)by (simp add: xcpt_app_def) (auto simp add: shift_def)(*>*)


lemma wt_instr_appL:
  " P,T,m,mpc,xt  i,pc :: τs; pc < size τs; mpc  size τs 
   P,T,m,mpc + size τs',shift (size τs') xt  i,pc+size τs' :: τs'@τs"
(*<*)
apply(auto simp:wt_instr_def app_def)
prefer 2 apply(fast)
prefer 2 apply(fast)
apply(cases "i",auto)
done
(*>*)


lemma wt_instr_Cons:
  " P,T,m,mpc - 1,[]  i,pc - 1 :: τs;
     0 < pc; 0 < mpc; pc < size τs + 1; mpc  size τs + 1 
   P,T,m,mpc,[]  i,pc :: τ#τs"
(*<*)
apply(drule wt_instr_appL[where τs' = "[τ]"])
apply arith
apply arith
apply (simp split:nat_diff_split_asm)
done
(*>*)


lemma wt_instr_append:
  " P,T,m,mpc - size τs',[]  i,pc - size τs' :: τs;
     size τs'  pc; size τs'  mpc; pc < size τs + size τs'; mpc  size τs + size τs' 
   P,T,m,mpc,[]  i,pc :: τs'@τs"
(*<*)
apply(drule wt_instr_appL[where τs' = τs'])
apply arith
apply arith
apply (simp split:nat_diff_split_asm)
done
(*>*)


lemma xcpt_app_pcs:
  "pc  pcs xt  xcpt_app i P pc mxs xt τ"
(*<*)
by (auto simp add: xcpt_app_def relevant_entries_def is_relevant_entry_def pcs_def)
(*>*)


lemma xcpt_eff_pcs:
  "pc  pcs xt  xcpt_eff i P pc τ xt = []"
(*<*)
by (cases τ)
   (auto simp add: is_relevant_entry_def xcpt_eff_def relevant_entries_def pcs_def
           intro!: filter_False)
(*>*)


lemma pcs_shift:
  "pc < n  pc  pcs (shift n xt)" 
(*<*)by (auto simp add: shift_def pcs_def)(*>*)


lemma wt_instr_appRx:
  " P,T,m,mpc,xt  is!pc,pc :: τs; pc < size is; size is < size τs; mpc  size τs 
   P,T,m,mpc,xt @ shift (size is) xt'  is!pc,pc :: τs"
(*<*)by (auto simp:wt_instr_def eff_def app_def xcpt_app_pcs xcpt_eff_pcs)(*>*)


lemma wt_instr_appLx: 
  " P,T,m,mpc,xt  i,pc :: τs; pc  pcs xt' 
   P,T,m,mpc,xt'@xt  i,pc :: τs"
(*<*)by (auto simp:wt_instr_def app_def eff_def xcpt_app_pcs xcpt_eff_pcs)(*>*)


lemma (in TC2) wt_instrs_extR:
  " is,xt [::] τs   is,xt [::] τs @ τs'"
(*<*)by(auto simp add:wt_instrs_def wt_instr_appR)(*>*)


lemma (in TC2) wt_instrs_ext:
  "  is1,xt1 [::] τs1@τs2;  is2,xt2 [::] τs2; size τs1 = size is1 
    is1@is2, xt1 @ shift (size is1) xt2 [::] τs1@τs2"
(*<*)
apply(clarsimp simp:wt_instrs_def)
apply(rule conjI, fastforce)
apply(rule conjI, fastforce)
apply clarsimp
apply(rule conjI, fastforce simp:wt_instr_appRx)
apply clarsimp
apply(erule_tac x = "pc - size is1" in allE)+
apply(thin_tac "P  Q" for P Q)
apply(erule impE, arith) 
apply(drule_tac τs' = "τs1" in wt_instr_appL)
  apply arith
 apply simp
apply(fastforce simp add:add.commute intro!: wt_instr_appLx)
done
(*>*)

corollary (in TC2) wt_instrs_ext2:
  "  is2,xt2 [::] τs2;  is1,xt1 [::] τs1@τs2; size τs1 = size is1 
    is1@is2, xt1 @ shift (size is1) xt2 [::] τs1@τs2"
(*<*)by(rule wt_instrs_ext)(*>*)


corollary (in TC2) wt_instrs_ext_prefix [trans]:
  "  is1,xt1 [::] τs1@τs2;  is2,xt2 [::] τs3;
     size τs1 = size is1; prefix τs3 τs2 
    is1@is2, xt1 @ shift (size is1) xt2 [::] τs1@τs2"
(*<*)by(bestsimp simp:prefix_def elim: wt_instrs_ext dest:wt_instrs_extR)(*>*)


corollary (in TC2) wt_instrs_app:
  assumes is1: " is1,xt1 [::] τs1@[τ]"
  assumes is2: " is2,xt2 [::] τ#τs2"
  assumes s: "size τs1 = size is1"
  shows " is1@is2, xt1@shift (size is1) xt2 [::] τs1@τ#τs2"
(*<*)
proof -
  from is1 have " is1,xt1 [::] (τs1@[τ])@τs2"
    by (rule wt_instrs_extR)
  hence " is1,xt1 [::] τs1@τ#τs2" by simp
  from this is2 s show ?thesis by (rule wt_instrs_ext) 
qed
(*>*)


corollary (in TC2) wt_instrs_app_last[trans]:
  "  is2,xt2 [::] τ#τs2;  is1,xt1 [::] τs1;
     last τs1 = τ;  size τs1 = size is1+1 
    is1@is2, xt1@shift (size is1) xt2 [::] τs1@τs2"
(*<*)
apply(cases τs1 rule:rev_cases)
 apply simp
apply(simp add:wt_instrs_app)
done
(*>*)


corollary (in TC2) wt_instrs_append_last[trans]:
  "  is,xt [::] τs; P,Tr,mxs,mpc,[]  i,pc :: τs;
     pc = size is; mpc = size τs; size is + 1 < size τs 
    is@[i],xt [::] τs"
(*<*)
apply(clarsimp simp add:wt_instrs_def)
apply(rule conjI, fastforce)
apply(fastforce intro!:wt_instr_appLx[where xt = "[]",simplified]
               dest!:less_antisym)
done
(*>*)


corollary (in TC2) wt_instrs_app2:
  "  is2,xt2 [::] τ'#τs2;   is1,xt1 [::] τ#τs1@[τ'];
     xt' = xt1 @ shift (size is1) xt2;  size τs1+1 = size is1 
    is1@is2,xt' [::] τ#τs1@τ'#τs2"
(*<*)using wt_instrs_app[where ?τs1.0 = "τ # τs1"] by simp (*>*)


corollary (in TC2) wt_instrs_app2_simp[trans,simp]:
  "  is2,xt2 [::] τ'#τs2;   is1,xt1 [::] τ#τs1@[τ']; size τs1+1 = size is1 
    is1@is2, xt1@shift (size is1) xt2 [::] τ#τs1@τ'#τs2"
(*<*)using wt_instrs_app[where ?τs1.0 = "τ # τs1"] by simp(*>*)


corollary (in TC2) wt_instrs_Cons[simp]:
  " τs  [];  [i],[] [::] [τ,τ'];  is,xt [::] τ'#τs 
    i#is,shift 1 xt [::] τ#τ'#τs"
(*<*)
using wt_instrs_app2[where ?is1.0 = "[i]" and ?τs1.0 = "[]" and ?is2.0 = "is"
                      and ?xt1.0 = "[]"]
by simp


corollary (in TC2) wt_instrs_Cons2[trans]:
  assumes τs: " is,xt [::] τs"
  assumes i: "P,Tr,mxs,mpc,[]  i,0 :: τ#τs"
  assumes mpc: "mpc = size τs + 1"
  shows " i#is,shift 1 xt [::] τ#τs"
(*<*)
proof -
  from τs have "τs  []" by (auto simp: wt_instrs_def)
  with mpc i have " [i],[] [::] [τ]@τs" by (simp add: wt_instrs_def)
  with τs show ?thesis by (fastforce dest: wt_instrs_ext)
qed
(*>*)


lemma (in TC2) wt_instrs_last_incr[trans]:
  "  is,xt [::] τs@[τ]; P  τ ≤' τ'    is,xt [::] τs@[τ']"
(*<*)
apply(clarsimp simp add:wt_instrs_def wt_instr_def)
apply(rule conjI)
apply(fastforce)
apply(clarsimp)
apply(rename_tac pc' tau')
apply(erule allE, erule (1) impE)
apply(clarsimp)
apply(drule (1) bspec)
apply(clarsimp)
apply(subgoal_tac "pc' = size τs")
prefer 2
apply(clarsimp simp:app_def)
apply(drule (1) bspec)
apply(clarsimp)
apply(auto elim!:sup_state_opt_trans)
done
(*>*)


lemma [iff]: "xcpt_app i P pc mxs [] τ"
(*<*)by (simp add: xcpt_app_def relevant_entries_def)(*>*)


lemma [simp]: "xcpt_eff i P pc τ [] = []"
(*<*)by (simp add: xcpt_eff_def relevant_entries_def)(*>*)


lemma (in TC2) wt_New:
  " is_class P C; size ST < mxs  
    [New C],[] [::] [tyi' ST E A, tyi' (Class C#ST) E A]"
(*<*)by(simp add:wt_defs tyi'_def)(*>*)


lemma (in TC2) wt_Cast:
  "is_class P C 
    [Checkcast C],[] [::] [tyi' (Class D # ST) E A, tyi' (Class C # ST) E A]"
(*<*)by(simp add: tyi'_def wt_defs)(*>*)


lemma (in TC2) wt_Push:
  " size ST < mxs; typeof v = Some T 
    [Push v],[] [::] [tyi' ST E A, tyi' (T#ST) E A]"
(*<*)by(simp add: tyi'_def wt_defs)(*>*)


lemma (in TC2) wt_Pop:
 " [Pop],[] [::] (tyi' (T#ST) E A # tyi' ST E A # τs)"
(*<*)by(simp add: tyi'_def wt_defs)(*>*)


lemma (in TC2) wt_CmpEq:
  " P  T1  T2  P  T2  T1
    [CmpEq],[] [::] [tyi' (T2 # T1 # ST) E A, tyi' (Boolean # ST) E A]"
(*<*) by(auto simp:tyi'_def wt_defs elim!: refTE not_refTE) (*>*)


lemma (in TC2) wt_IAdd:
  " [IAdd],[] [::] [tyi' (Integer#Integer#ST) E A, tyi' (Integer#ST) E A]"
(*<*)by(simp add:tyi'_def wt_defs)(*>*)


lemma (in TC2) wt_Load:
  " size ST < mxs; size E  mxl; i ∈∈ A; i < size E 
    [Load i],[] [::] [tyi' ST E A, tyi' (E!i # ST) E A]"
(*<*)by(auto simp add:tyi'_def wt_defs tyl_def hyperset_defs)(*>*)


lemma (in TC2) wt_Store:
 " P  T  E!i; i < size E; size E  mxl  
   [Store i],[] [::] [tyi' (T#ST) E A, tyi' ST E ({i}  A)]"
(*<*)
by(auto simp:hyperset_defs nth_list_update tyi'_def wt_defs tyl_def
        intro:list_all2_all_nthI)
(*>*)


lemma (in TC2) wt_Get:
 " P  C sees F,NonStatic:T in D  
   [Getfield F D],[] [::] [tyi' (Class C # ST) E A, tyi' (T # ST) E A]"
(*<*)by(auto simp: tyi'_def wt_defs dest: sees_field_idemp sees_field_decl_above)(*>*)

lemma (in TC2) wt_GetS:
 " size ST < mxs; P  C sees F,Static:T in D  
   [Getstatic C F D],[] [::] [tyi' ST E A, tyi' (T # ST) E A]"
(*<*)by(auto simp: tyi'_def wt_defs dest: sees_field_idemp sees_field_decl_above)(*>*)

lemma (in TC2) wt_Put:
  " P  C sees F,NonStatic:T in D; P  T'  T  
   [Putfield F D],[] [::] [tyi' (T' # Class C # ST) E A, tyi' ST E A]"
(*<*)by(auto intro: sees_field_idemp sees_field_decl_above simp: tyi'_def wt_defs)(*>*)

lemma (in TC2) wt_PutS:
  " P  C sees F,Static:T in D; P  T'  T  
   [Putstatic C F D],[] [::] [tyi' (T' # ST) E A, tyi' ST E A]"
(*<*)by(auto intro: sees_field_idemp sees_field_decl_above simp: tyi'_def wt_defs)(*>*)


lemma (in TC2) wt_Throw:
  " [Throw],[] [::] [tyi' (Class C # ST) E A, τ']"
(*<*)by(auto simp: tyi'_def wt_defs)(*>*)


lemma (in TC2) wt_IfFalse:
  " 2  i; nat i < size τs + 2; P  tyi' ST E A ≤' τs ! nat(i - 2) 
    [IfFalse i],[] [::] tyi' (Boolean # ST) E A # tyi' ST E A # τs"
(*<*)
by(simp add: tyi'_def wt_defs eval_nat_numeral nat_diff_distrib)
(*>*)


lemma wt_Goto:
 " 0  int pc + i; nat (int pc + i) < size τs; size τs  mpc;
    P  τs!pc ≤' τs ! nat (int pc + i) 
  P,T,mxs,mpc,[]  Goto i,pc :: τs"
(*<*)by(clarsimp simp add: TC2.wt_defs)(*>*)


lemma (in TC2) wt_Invoke:
  " size es = size Ts'; P  C sees M,NonStatic: TsT = m in D; P  Ts' [≤] Ts 
    [Invoke M (size es)],[] [::] [tyi' (rev Ts' @ Class C # ST) E A, tyi' (T#ST) E A]"
(*<*)by(fastforce simp add: tyi'_def wt_defs)(*>*)

lemma (in TC2) wt_Invokestatic:
  " size ST < mxs; size es = size Ts'; M  clinit;
     P  C sees M,Static: TsT = m in D; P  Ts' [≤] Ts 
    [Invokestatic C M (size es)],[] [::] [tyi' (rev Ts' @ ST) E A, tyi' (T#ST) E A]"
(*<*)by(fastforce simp add: tyi'_def wt_defs)(*>*)


corollary (in TC2) wt_instrs_app3[simp]:
  "  is2,[] [::] (τ' # τs2);   is1,xt1 [::] τ # τs1 @ [τ']; size τs1+1 = size is1
    (is1 @ is2),xt1 [::] τ # τs1 @ τ' # τs2"
(*<*)using wt_instrs_app2[where ?xt2.0 = "[]"] by (simp add:shift_def)(*>*)


corollary (in TC2) wt_instrs_Cons3[simp]:
  " τs  [];  [i],[] [::] [τ,τ'];  is,[] [::] τ'#τs 
    (i # is),[] [::] τ # τ' # τs"
(*<*)
using wt_instrs_Cons[where ?xt = "[]"]
by (simp add:shift_def)

(*<*)
declare nth_append[simp del]
declare [[simproc del: list_to_set_comprehension]]
(*>*)

lemma (in TC2) wt_instrs_xapp[trans]:
  "  is1 @ is2, xt [::] τs1 @ tyi' (Class C # ST) E A # τs2;
     τ  set τs1. ST' LT'. τ = Some(ST',LT')  
      size ST  size ST'  P  Some (drop (size ST' - size ST) ST',LT') ≤' tyi' ST E A;
     size is1 = size τs1; is_class P C; size ST < mxs   
   is1 @ is2, xt @ [(0,size is1 - 1,C,size is1,size ST)] [::] τs1 @ tyi' (Class C # ST) E A # τs2"
(*<*)
apply(simp add:wt_instrs_def)
apply(rule conjI)
 apply(clarsimp)
 apply arith
apply clarsimp
apply(erule allE, erule (1) impE)
apply(clarsimp simp add: wt_instr_def app_def eff_def)
apply(rule conjI)
 apply (thin_tac "x A  B. P x" for A B P)
 apply (thin_tac "x A  B. P x" for A B P)
 apply (clarsimp simp add: xcpt_app_def relevant_entries_def)
 apply (simp add: nth_append is_relevant_entry_def split!: if_splits)
  apply (drule_tac x="τs1!pc" in bspec)
   apply (blast intro: nth_mem) 
  apply fastforce
apply (rule conjI)
 apply clarsimp
 apply (erule disjE, blast)
 apply (erule disjE, blast)
 apply (clarsimp simp add: xcpt_eff_def relevant_entries_def split: if_split_asm)
apply clarsimp
apply (erule disjE, blast)
apply (erule disjE, blast)
apply (clarsimp simp add: xcpt_eff_def relevant_entries_def split: if_split_asm)
apply (simp add: nth_append is_relevant_entry_def split: if_split_asm)
 apply (drule_tac x = "τs1!pc" in bspec)
  apply (blast intro: nth_mem) 
 apply (fastforce simp add: tyi'_def)
done

declare [[simproc add: list_to_set_comprehension]]
declare nth_append[simp]
(*>*)

lemma drop_Cons_Suc:
  "xs. drop n xs = y#ys  drop (Suc n) xs = ys"
  apply (induct n)
   apply simp
  apply (simp add: drop_Suc)
  done

lemma drop_mess:
  "Suc (length xs0)  length xs; drop (length xs - Suc (length xs0)) xs = x # xs0 
   drop (length xs - length xs0) xs = xs0"
apply (cases xs)
 apply simp
apply (simp add: Suc_diff_le)
apply (case_tac "length list - length xs0")
 apply simp
apply (simp add: drop_Cons_Suc)
done

(*<*)
declare (in TC0)
  after_def[simp] pair_eq_tyi'_conv[simp]
(*>*)

lemma (in TC1) compT_ST_prefix:
 "E A ST0. (ST,LT)  set(compT E A ST0 e)  
  size ST0  size ST  drop (size ST - size ST0) ST = ST0"
and
 "E A ST0. (ST,LT)  set(compTs E A ST0 es)  
  size ST0  size ST  drop (size ST - size ST0) ST = ST0"
(*<*)
proof(induct e and es rule: compT.induct compTs.induct)
  case (FAss e1 F D e2)
  moreover {
    let ?ST0 = "ty E e1 # ST0"
    fix A assume "(ST, LT)  set (compT E A ?ST0 e2)"
    with FAss
    have "length ?ST0  length ST  drop (size ST - size ?ST0) ST = ?ST0" by blast
    hence ?case  by (clarsimp simp add: drop_mess)
  }
  ultimately show ?case by auto
next
  case TryCatch thus ?case by auto
next
  case Block thus ?case by auto
next
  case Seq thus ?case by auto
next
  case While thus ?case by auto
next
  case Cond thus ?case by auto
next
  case (Call e M es)
  moreover {
    let ?ST0 = "ty E e # ST0"
    fix A assume "(ST, LT)  set (compTs E A ?ST0 es)"
    with Call
    have "length ?ST0  length ST  drop (size ST - size ?ST0) ST = ?ST0" by blast
    hence ?case  by (clarsimp simp add: drop_mess)
  }
  ultimately show ?case by auto
next
  case (Cons_exp e es)
  moreover {
    let ?ST0 = "ty E e # ST0"
    fix A assume "(ST, LT)  set (compTs E A ?ST0 es)"
    with Cons_exp
    have "length ?ST0  length ST  drop (size ST - size ?ST0) ST = ?ST0" by blast
    hence ?case  by (clarsimp simp add: drop_mess)
  }
  ultimately show ?case by auto
next
  case (BinOp e1 bop e2)
  moreover {
    let ?ST0 = "ty E e1 # ST0"
    fix A assume "(ST, LT)  set (compT E A ?ST0 e2)"
    with BinOp 
    have "length ?ST0  length ST  drop (size ST - size ?ST0) ST = ?ST0" by blast
    hence ?case by (clarsimp simp add: drop_mess)
  }
  ultimately show ?case by auto
next
  case new thus ?case by auto
next
  case Val thus ?case by auto    
next
  case Cast thus ?case by auto
next
  case Var thus ?case by auto
next
  case LAss thus ?case by auto
next
  case throw thus ?case by auto
next
  case FAcc thus ?case by auto
next
  case SFAcc thus ?case by auto
next
  case SFAss thus ?case by auto
next
  case (SCall C M es) thus ?case by auto
next
  case INIT thus ?case by auto
next
  case RI thus ?case by auto
next
  case Nil_exp thus ?case by auto
qed 

declare (in TC0) 
  after_def[simp del] pair_eq_tyi'_conv[simp del]
(*>*)

(* FIXME *)
lemma fun_of_simp [simp]: "fun_of S x y = ((x,y)  S)" 
(*<*) by (simp add: fun_of_def)(*>*)

theorem (in TC2) compT_wt_instrs: "E T A ST.
   P,E 1 e :: T; 𝒟 e A;e (size E); 
    size ST + max_stack e  mxs; size E + max_vars e  mxl 
    compE2 e, compxE2 e 0 (size ST) [::]
                 tyi' ST E A # compT E A ST e @ [after E A ST e]"
(*<*)(is "E T A ST. PROP ?P e E T A ST")(*>*)

and "E Ts A ST.
   P,E 1 es[::]Ts;  𝒟s es A; ℬs es (size E); 
    size ST + max_stacks es  mxs; size E + max_varss es  mxl 
   let τs = tyi' ST E A # compTs E A ST es in
        compEs2 es,compxEs2 es 0 (size ST) [::] τs 
       last τs = tyi' (rev Ts @ ST) E (A  𝒜s es)"
(*<*)
(is "E Ts A ST. PROP ?Ps es E Ts A ST")
proof(induct e and es rule: compxE2.induct compxEs2.induct)
  case (TryCatch e1 C i e2)
  hence [simp]: "i = size E" by simp
  have wt1: "P,E 1 e1 :: T" and wt2: "P,E@[Class C] 1 e2 :: T"
    and "class": "is_class P C" using TryCatch by auto
  let ?A1 = "A  𝒜 e1" let ?Ai = "A  {i}" let ?Ei = "E @ [Class C]"
  let  = "tyi' ST E A" let ?τs1 = "compT E A ST e1"
  let 1 = "tyi' (T#ST) E ?A1" let 2 = "tyi' (Class C#ST) E A"
  let 3 = "tyi' ST ?Ei ?Ai" let ?τs2 = "compT ?Ei ?Ai ST e2"
  let 2' = "tyi' (T#ST) ?Ei (?Ai  𝒜 e2)"
  let ?τ' = "tyi' (T#ST) E (A  𝒜 e1  (𝒜 e2  i))"
  let ?go = "Goto (int(size(compE2 e2)) + 2)"
  have "PROP ?P e2 ?Ei T ?Ai ST" by fact
  hence " compE2 e2,compxE2 e2 0 (size ST) [::] (3 # ?τs2) @ [2']"
    using TryCatch.prems by(auto simp:after_def)
  also have "?Ai  𝒜 e2 = (A  𝒜 e2)  {size E}"
    by(fastforce simp:hyperset_defs)
  also have "P  tyi' (T#ST) ?Ei  ≤' tyi' (T#ST) E (A  𝒜 e2)"
    by(simp add:hyperset_defs tyl_incr tyi'_def)
  also have "P   ≤' tyi' (T#ST) E (A  𝒜 e1  (𝒜 e2  i))"
    by(auto intro!: tyl_antimono simp:hyperset_defs tyi'_def)
  also have "(3 # ?τs2) @ [?τ'] = 3 # ?τs2 @ [?τ']" by simp
  also have " [Store i],[] [::] 2 # [] @ [3]"
    using TryCatch.prems
    by(auto simp:nth_list_update wt_defs tyi'_def tyl_def
      list_all2_conv_all_nth hyperset_defs)
  also have "[] @ (3 # ?τs2 @ [?τ']) = (3 # ?τs2 @ [?τ'])" by simp
  also have "P,Tr,mxs,size(compE2 e2)+3,[]  ?go,0 :: 1#2#3#?τs2 @ [?τ']" using wt2
    by (auto simp: hyperset_defs tyi'_def wt_defs nth_Cons nat_add_distrib
      fun_of_def intro: tyl_antimono list_all2_refl split:nat.split)
  also have " compE2 e1,compxE2 e1 0 (size ST) [::]  # ?τs1 @ [1]"
    using TryCatch by(auto simp:after_def)
  also have " # ?τs1 @ 1 # 2 # 3 # ?τs2 @ [?τ'] =
             ( # ?τs1 @ [1]) @ 2 # 3 # ?τs2 @ [?τ']" by simp
  also have "compE2 e1 @ ?go  # [Store i] @ compE2 e2 =
             (compE2 e1 @ [?go]) @ (Store i # compE2 e2)" by simp
  also 
  let "?Q τ" = "ST' LT'. τ = (ST', LT')  
    size ST  size ST'  P  Some (drop (size ST' - size ST) ST',LT') ≤' tyi' ST E A"
  {
    have "?Q (tyi' ST E A)" by (clarsimp simp add: tyi'_def)
    moreover have "?Q (tyi' (T # ST) E ?A1)" 
      by (fastforce simp add: tyi'_def hyperset_defs intro!: tyl_antimono)
    moreover have "τ. τ  set (compT E A ST e1)  ?Q τ" using TryCatch.prems
      by clarsimp (frule compT_ST_prefix,
                   fastforce dest!: compT_LT_prefix simp add: tyi'_def)
    ultimately
    have "τset (tyi' ST E A # compT E A ST e1 @ [tyi' (T # ST) E ?A1]). ?Q τ" 
      by auto
  }
  also from TryCatch.prems max_stack1[OF wt1] have "size ST + 1  mxs" by auto
  ultimately show ?case using wt1 wt2 TryCatch.prems "class"
    by (simp add:after_def)
next
  case new thus ?case by(auto simp add:after_def wt_New)
next
  case (BinOp e1 bop e2) 
  let ?op = "case bop of Eq  [CmpEq] | Add  [IAdd]"
  have T: "P,E 1 e1 «bop» e2 :: T" by fact
  then obtain T1 T2 where T1: "P,E 1 e1 :: T1" and T2: "P,E 1 e2 :: T2" and 
    bopT: "case bop of Eq  (P  T1  T2  P  T2  T1)  T = Boolean 
                    | Add  T1 = Integer  T2 = Integer  T = Integer" by auto
  let ?A1 = "A  𝒜 e1" let ?A2 = "?A1  𝒜 e2"
  let  = "tyi' ST E A" let ?τs1 = "compT E A ST e1"
  let 1 = "tyi' (T1#ST) E ?A1" let ?τs2 = "compT E ?A1 (T1#ST) e2"
  let 2 = "tyi' (T2#T1#ST) E ?A2" let ?τ' = "tyi' (T#ST) E ?A2"
  from bopT have " ?op,[] [::] [2,?τ']" 
    by (cases bop) (auto simp add: wt_CmpEq wt_IAdd)
  also have "PROP ?P e2 E T2 ?A1 (T1#ST)" by fact
  with BinOp.prems T2 
  have " compE2 e2, compxE2 e2 0 (size (T1#ST)) [::] 1#?τs2@[2]" 
    by (auto simp: after_def)
  also from BinOp T1 have " compE2 e1, compxE2 e1 0 (size ST) [::] #?τs1@[1]" 
    by (auto simp: after_def)
  finally show ?case using T T1 T2 by (simp add: after_def hyperUn_assoc)
next
  case (Cons_exp e es)
  have "P,E 1 e # es [::] Ts" by fact
  then obtain Te Ts' where 
    Te: "P,E 1 e :: Te" and Ts': "P,E 1 es [::] Ts'" and
    Ts: "Ts = Te#Ts'" by auto
  let ?Ae = "A  𝒜 e"  
  let  = "tyi' ST E A" let ?τse = "compT E A ST e"  
  let e = "tyi' (Te#ST) E ?Ae" let ?τs' = "compTs E ?Ae (Te#ST) es"
  let ?τs = " # ?τse @ (e # ?τs')"
  have Ps: "PROP ?Ps es E Ts' ?Ae (Te#ST)" by fact
  with Cons_exp.prems Te Ts'
  have " compEs2 es, compxEs2 es 0 (size (Te#ST)) [::] e#?τs'" by (simp add: after_def)
  also from Cons_exp Te have " compE2 e, compxE2 e 0 (size ST) [::] #?τse@[e]" 
    by (auto simp: after_def)
  moreover
  from Ps Cons_exp.prems Te Ts' Ts
  have "last ?τs = tyi' (rev Ts@ST) E (?Ae  𝒜s es)" by simp
  ultimately show ?case using Te by (simp add: after_def hyperUn_assoc)
next
  case (FAss e1 F D e2)
  hence Void: "P,E 1 e1F{D} := e2 :: Void" by auto
  then obtain C T T' where    
    C: "P,E 1 e1 :: Class C" and sees: "P  C sees F,NonStatic:T in D" and
    T': "P,E 1 e2 :: T'" and T'_T: "P  T'  T" by auto
  let ?A1 = "A  𝒜 e1" let ?A2 = "?A1  𝒜 e2"  
  let  = "tyi' ST E A" let ?τs1 = "compT E A ST e1"
  let 1 = "tyi' (Class C#ST) E ?A1" let ?τs2 = "compT E ?A1 (Class C#ST) e2"
  let 2 = "tyi' (T'#Class C#ST) E ?A2" let 3 = "tyi' ST E ?A2"
  let ?τ' = "tyi' (Void#ST) E ?A2"
  from FAss.prems sees T'_T 
  have " [Putfield F D,Push Unit],[] [::] [2,3,?τ']"
    by (fastforce simp add: wt_Push wt_Put)
  also have "PROP ?P e2 E T' ?A1 (Class C#ST)" by fact
  with FAss.prems T' 
  have " compE2 e2, compxE2 e2 0 (size ST+1) [::] 1#?τs2@[2]"
    by (auto simp add: after_def hyperUn_assoc) 
  also from FAss C have " compE2 e1, compxE2 e1 0 (size ST) [::] #?τs1@[1]" 
    by (auto simp add: after_def)
  finally show ?case using Void C T' by (simp add: after_def hyperUn_assoc) 
next
  case (SFAss C F D e2)
  hence Void: "P,E 1 CsF{D} := e2 :: Void" by auto
  then obtain T T' where    
    sees: "P  C sees F,Static:T in D" and
    T': "P,E 1 e2 :: T'" and T'_T: "P  T'  T" by auto
  let ?A2 = "A  𝒜 e2"  
  let  = "tyi' ST E A" let ?τs2 = "compT E A ST e2"
  let 2 = "tyi' (T'#ST) E ?A2" let 3 = "tyi' ST E ?A2"
  let ?τ' = "tyi' (Void#ST) E ?A2"
  from SFAss.prems sees T'_T max_stack1[OF T']
  have " [Putstatic C F D,Push Unit],[] [::] [2,3,?τ']"
    by (fastforce simp add: wt_Push wt_PutS)
  also have "PROP ?P e2 E T' A ST" by fact
  with SFAss.prems T' 
  have " compE2 e2, compxE2 e2 0 (size ST) [::] #?τs2@[2]"
    by (auto simp add: after_def hyperUn_assoc)
  finally show ?case using Void T' by (simp add: after_def hyperUn_assoc) 
next
  case Val thus ?case by(auto simp:after_def wt_Push)
next
  case Cast thus ?case by (auto simp:after_def wt_Cast)
next
  case (Block i Ti e)
  let ?τs = "tyi' ST E A # compT (E @ [Ti]) (Ai) ST e"
  have IH: "PROP ?P e (E@[Ti]) T (Ai) ST" by fact
  hence " compE2 e, compxE2 e 0 (size ST) [::]
         ?τs @ [tyi' (T#ST) (E@[Ti]) (A(size E)  𝒜 e)]"
    using Block.prems by (auto simp add: after_def)
  also have "P  tyi' (T # ST) (E@[Ti]) (A  size E  𝒜 e) ≤'
                 tyi' (T # ST) (E@[Ti]) ((A  𝒜 e)  size E)"
     by(auto simp add:hyperset_defs intro: tyi'_antimono)
  also have " = tyi' (T # ST) E (A  𝒜 e)" by simp
  also have "P   ≤' tyi' (T # ST) E (A  (𝒜 e  i))"
     by(auto simp add:hyperset_defs intro: tyi'_antimono)
  finally show ?case using Block.prems by(simp add: after_def)
next
  case Var thus ?case by(auto simp:after_def wt_Load)
next
  case FAcc thus ?case by(auto simp:after_def wt_Get)
next
  case SFAcc thus ?case by(auto simp: after_def wt_GetS)
next
  case (LAss i e)
  then obtain T' where wt: "P,E 1 e :: T'" by auto
  show ?case using max_stack1[OF wt] LAss
    by(auto simp: hyper_insert_comm after_def wt_Store wt_Push)
next
  case Nil_exp thus ?case by auto
next
  case throw thus ?case by(auto simp add: after_def wt_Throw)
next
  case (While e c)
  obtain Tc where wte: "P,E 1 e :: Boolean" and wtc: "P,E 1 c :: Tc"
    and [simp]: "T = Void" using While by auto
  have [simp]: "ty E (while (e) c) = Void" using While by simp
  let ?A0 = "A  𝒜 e" let ?A1 = "?A0  𝒜 c"
  let  = "tyi' ST E A" let ?τse = "compT E A ST e"
  let e = "tyi' (Boolean#ST) E ?A0" let 1 = "tyi' ST E ?A0"
  let ?τsc = "compT E ?A0 ST c" let c = "tyi' (Tc#ST) E ?A1"
  let 2 = "tyi' ST E ?A1" let ?τ' = "tyi' (Void#ST) E ?A0"
  let ?τs = "( # ?τse @ [e]) @ 1 # ?τsc @ [c, 2, 1, ?τ']"
  have " [],[] [::] [] @ ?τs" by(simp add:wt_instrs_def)
  also
  have "PROP ?P e E Boolean A ST" by fact
  hence " compE2 e,compxE2 e 0 (size ST) [::]  # ?τse @ [e]"
    using While.prems by (auto simp:after_def)
  also
  have "[] @ ?τs = ( # ?τse) @ e # 1 # ?τsc @ [c,2,1,?τ']" by simp
  also
  let ?ne = "size(compE2 e)"  let ?nc = "size(compE2 c)"
  let ?if = "IfFalse (int ?nc + 3)"
  have " [?if],[] [::] e # 1 # ?τsc @ [c, 2, 1, ?τ']" using wtc
    by(simp add: wt_instr_Cons wt_instr_append wt_IfFalse
                 nat_add_distrib split: nat_diff_split)
  also
  have "( # ?τse) @ (e # 1 # ?τsc @ [c, 2, 1, ?τ']) = ?τs" by simp
  also
  have "PROP ?P c E Tc ?A0 ST" by fact
  hence " compE2 c,compxE2 c 0 (size ST) [::] 1 # ?τsc @ [c]"
    using While.prems wtc by (auto simp:after_def)
  also have "?τs = ( # ?τse @ [e,1] @ ?τsc) @ [c,2,1,?τ']" by simp
  also have " [Pop],[] [::] [c, 2]"  by(simp add:wt_Pop)
  also have "( # ?τse @ [e,1] @ ?τsc) @ [c,2,1,?τ'] = ?τs" by simp
  also let ?go = "Goto (-int(?nc+?ne+2))"
  have "P  2 ≤' " by(fastforce intro: tyi'_antimono simp: hyperset_defs)
  hence "P,Tr,mxs,size ?τs,[]  ?go,?ne+?nc+2 :: ?τs" using wte wtc
    by(simp add: wt_Goto split: nat_diff_split)
  also have "?τs = ( # ?τse @ [e,1] @ ?τsc @ [c, 2]) @ [1, ?τ']"
    by simp
  also have " [Push Unit],[] [::] [1,?τ']"
    using While.prems max_stack1[OF wtc] by(auto simp add:wt_Push)
  finally show ?case using wtc wte
    by (simp add:after_def)
next
  case (Cond e e1 e2)
  obtain T1 T2 where wte: "P,E 1 e :: Boolean"
    and wt1: "P,E 1 e1 :: T1" and wt2: "P,E 1 e2 :: T2"
    and sub1: "P  T1  T" and sub2: "P  T2  T"
    using Cond by auto
  have [simp]: "ty E (if (e) e1 else e2) = T" using Cond by simp
  let ?A0 = "A  𝒜 e" let ?A2 = "?A0  𝒜 e2" let ?A1 = "?A0  𝒜 e1"
  let ?A' = "?A0  𝒜 e1  𝒜 e2"
  let 2 = "tyi' ST E ?A0" let ?τ' = "tyi' (T#ST) E ?A'"
  let ?τs2 = "compT E ?A0 ST e2"
  have "PROP ?P e2 E T2 ?A0 ST" by fact
  hence " compE2 e2, compxE2 e2 0 (size ST) [::] (2#?τs2) @ [tyi' (T2#ST) E ?A2]"
    using Cond.prems wt2 by(auto simp add:after_def)
  also have "P  tyi' (T2#ST) E ?A2 ≤' ?τ'" using sub2
    by(auto simp add: hyperset_defs tyi'_def intro!: tyl_antimono)
  also
  let 3 = "tyi' (T1 # ST) E ?A1"
  let ?g2 = "Goto(int (size (compE2 e2) + 1))"
  from sub1 have "P,Tr,mxs,size(compE2 e2)+2,[]  ?g2,0 :: 3#(2#?τs2)@[?τ']" using wt2
    by(auto simp: hyperset_defs wt_defs nth_Cons tyi'_def
             split:nat.split intro!: tyl_antimono)
  also
  let ?τs1 = "compT E ?A0 ST e1"
  have "PROP ?P e1 E T1 ?A0 ST" by fact
  hence " compE2 e1,compxE2 e1 0 (size ST) [::] 2 # ?τs1 @ [3]"
    using Cond.prems wt1 by(auto simp add:after_def)
  also
  let ?τs12 = "2 # ?τs1 @ 3 # (2 # ?τs2) @ [?τ']"
  let 1 = "tyi' (Boolean#ST) E ?A0"
  let ?g1 = "IfFalse(int (size (compE2 e1) + 2))"
  let ?code = "compE2 e1 @ ?g2 # compE2 e2"
  have " [?g1],[] [::] [1] @ ?τs12" using wt1
    by(simp add: wt_IfFalse nat_add_distrib split:nat_diff_split)
  also (wt_instrs_ext2) have "[1] @ ?τs12 = 1 # ?τs12" by simp also
  let  = "tyi' ST E A"
  have "PROP ?P e E Boolean A ST" by fact
  hence " compE2 e, compxE2 e 0 (size ST) [::]  # compT E A ST e @ [1]"
    using Cond.prems wte by(auto simp add:after_def)
  finally show ?case using wte wt1 wt2 by(simp add:after_def hyperUn_assoc)
next
  case (Call e M es)
  obtain C D Ts m Ts' where C: "P,E 1 e :: Class C"
    and "method": "P  C sees M,NonStatic:Ts  T = m in D"
    and wtes: "P,E 1 es [::] Ts'" and subs: "P  Ts' [≤] Ts"
    using Call.prems by auto
  from wtes have same_size: "size es = size Ts'" by(rule WTs1_same_size)
  let ?A0 = "A  𝒜 e" let ?A1 = "?A0  𝒜s es"
  let  = "tyi' ST E A" let ?τse = "compT E A ST e"
  let e = "tyi' (Class C # ST) E ?A0"
  let ?τses = "compTs E ?A0 (Class C # ST) es"
  let 1 = "tyi' (rev Ts' @ Class C # ST) E ?A1"
  let ?τ' = "tyi' (T # ST) E ?A1"
  have " [Invoke M (size es)],[] [::] [1,?τ']"
    by(rule wt_Invoke[OF same_size "method" subs])
  also
  have "PROP ?Ps es E Ts' ?A0 (Class C # ST)" by fact
  hence " compEs2 es,compxEs2 es 0 (size ST+1) [::] e # ?τses"
        "last (e # ?τses) = 1"
    using Call.prems wtes by(auto simp add:after_def)
  also have "(e # ?τses) @ [?τ'] = e # ?τses @ [?τ']" by simp
  also have " compE2 e,compxE2 e 0 (size ST) [::]  # ?τse @ [e]"
    using Call C by(auto simp add:after_def)
  finally show ?case using Call.prems C wtes by(simp add:after_def hyperUn_assoc)
next
  case (SCall C M es)
  obtain D Ts m Ts' where "method": "P  C sees M,Static:Ts  T = m in D"
    and wtes: "P,E 1 es [::] Ts'" and subs: "P  Ts' [≤] Ts"
    using SCall.prems by auto
  from SCall.prems(1) have nclinit: "M  clinit" by auto
  from wtes have same_size: "size es = size Ts'" by(rule WTs1_same_size)
  have mxs: "length ST < mxs" using WT1_nsub_RI[OF SCall.prems(1)] SCall.prems(4) by simp
  let ?A1 = "A  𝒜s es"
  let  = "tyi' ST E A"
  let ?τses = "compTs E A ST es"
  let 1 = "tyi' (rev Ts' @ ST) E ?A1"
  let ?τ' = "tyi' (T # ST) E ?A1"
  have " [Invokestatic C M (size es)],[] [::] [1,?τ']"
    by(rule wt_Invokestatic[OF mxs same_size nclinit "method" subs])
  also
  have "PROP ?Ps es E Ts' A ST" by fact
  hence " compEs2 es,compxEs2 es 0 (size ST) [::]  # ?τses"
        "last ( # ?τses) = 1"
    using SCall.prems wtes by(auto simp add:after_def)
  also have "( # ?τses) @ [?τ'] =  # ?τses @ [?τ']" by simp
  finally show ?case using SCall.prems wtes by(simp add:after_def hyperUn_assoc)
next
  case Seq thus ?case
    by(auto simp:after_def)
      (fastforce simp:wt_Push wt_Pop hyperUn_assoc
                intro:wt_instrs_app2 wt_instrs_Cons)
next
  case (INIT C Cs b e)
  have "P,E 1 INIT C (Cs,b)  e :: T" by fact
  thus ?case using WT1_nsub_RI by simp
next
  case (RI C e' Cs e)
  have "P,E 1 RI (C,e') ; Cs  e :: T" by fact
  thus ?case using WT1_nsub_RI by simp
qed
(*>*)


lemma [simp]: "types (compP f P) = types P"
(*<*)by auto(*>*)

lemma [simp]: "states (compP f P) mxs mxl = states P mxs mxl"
(*<*)by (simp add: JVM_states_unfold)(*>*)

lemma [simp]: "appi (i, compP f P, pc, mpc, T, τ) = appi (i, P, pc, mpc, T, τ)"
(*<*)
  apply (cases τ)  
  apply (cases i)
  apply auto
― ‹ Invoke ›
   apply (fastforce dest!: sees_method_compPD)
  apply (force dest: sees_method_compP)
― ‹ Invokestatic ›
   apply (force dest!: sees_method_compPD)
  apply (force dest: sees_method_compP)
  done
(*>*)
  
lemma [simp]: "is_relevant_entry (compP f P) i = is_relevant_entry P i"
(*<*)
  apply (rule ext)+
  apply (unfold is_relevant_entry_def)
  apply (cases i)
  apply auto
  done
(*>*)

lemma [simp]: "relevant_entries (compP f P) i pc xt = relevant_entries P i pc xt"
(*<*) by (simp add: relevant_entries_def)(*>*)

lemma [simp]: "app i (compP f P) mpc T pc mxl xt τ = app i P mpc T pc mxl xt τ"
(*<*)
  apply (simp add: app_def xcpt_app_def eff_def xcpt_eff_def norm_eff_def)
  apply (fastforce simp add: image_def)
  done
(*>*)

lemma [simp]: "app i P mpc T pc mxl xt τ  eff i (compP f P) pc xt τ = eff i P pc xt τ"
(*<*)
  apply (clarsimp simp add: eff_def norm_eff_def xcpt_eff_def app_def)
  apply (cases i)
  apply auto
  done
(*>*)

lemma [simp]: "subtype (compP f P) = subtype P"
(*<*)
  apply (rule ext)+
  apply (simp)
  done
(*>*)
  
lemma [simp]: "compP f P  τ ≤' τ' = P  τ ≤' τ'"
(*<*) by (simp add: sup_state_opt_def sup_state_def sup_ty_opt_def)(*>*)

lemma [simp]: "compP f P,T,mpc,mxl,xt  i,pc :: τs = P,T,mpc,mxl,xt  i,pc :: τs"
(*<*)by (simp add: wt_instr_def cong: conj_cong)(*>*)

declare TC1.compT_sizes[simp]  TC0.ty_def2[simp]

context TC2
begin

lemma compT_method_NonStatic:
  fixes e and A and C and Ts and mxl0
  defines [simp]: "E  Class C # Ts"
    and [simp]: "A  {..size Ts}"
    and [simp]: "A'  A  𝒜 e"
    and [simp]: "mxl0  max_vars e"
  assumes mxs: "max_stack e = mxs"
    and mxl: "Suc (length Ts + max_vars e) = mxl"
  assumes assm: "wf_prog p P" "P,E 1 e :: T" "𝒟 e A" "ℬ e (size E)"
    "set E  types P" "P  T  Tr"
  shows "wt_method (compP2 P) C NonStatic Ts Tr mxs mxl0 (compE2 e @ [Return])
    (compxE2 e 0 0) (tyi' [] E A # compTa E A [] e)"
(*<*)
using assms apply (simp add: wt_method_def compTa_def after_def mxl)
apply (rule conjI)
 apply (simp add: check_types_def OK_tyi'_in_statesI)
 apply (rule conjI)
  apply (drule (1) WT1_is_type)
   apply simp
  apply (insert max_stack1 [where e=e])
  apply (rule OK_tyi'_in_statesI) apply (simp_all add: mxs)[3]
 apply (erule compT_states(1))
     apply assumption
    apply (simp_all add: mxs mxl)[4]
apply (rule conjI)
 apply (auto simp add: wt_start_def tyi'_def tyl_def list_all2_conv_all_nth
   nth_Cons mxl split: nat.split dest: less_antisym)[1]
apply (frule (1) TC2.compT_wt_instrs [of P _ _ _ _ "[]" "max_stack e" "Suc (length Ts + max_vars e)" Tr])
   apply simp_all
apply (clarsimp simp: after_def)
apply hypsubst_thin
apply (rule conjI)
 apply (clarsimp simp: wt_instrs_def after_def mxl mxs)
apply clarsimp
apply (drule (1) less_antisym)
apply (clarsimp simp: wt_defs xcpt_app_pcs xcpt_eff_pcs tyi'_def)
done
(*>*)

lemma compT_method_Static:
  fixes e and A and C and Ts and mxl0
  defines [simp]: "E  Ts"
    and [simp]: "A  {..<size Ts}"
    and [simp]: "A'  A  𝒜 e"
    and [simp]: "mxl0  max_vars e"
  assumes mxs: "max_stack e = mxs"
    and mxl: "length Ts + max_vars e = mxl"
  assumes assm: "wf_prog p P" "P,E 1 e :: T" "𝒟 e A" "ℬ e (size E)"
    "set E  types P" "P  T  Tr"
  shows "wt_method (compP2 P) C Static Ts Tr mxs mxl0 (compE2 e @ [Return])
    (compxE2 e 0 0) (tyi' [] E A # compTa E A [] e)"
(*<*)
using assms apply (simp add: wt_method_def compTa_def after_def mxl)
apply (rule conjI)
 apply (simp add: check_types_def OK_tyi'_in_statesI)
 apply (rule conjI)
  apply (drule (1) WT1_is_type)
   apply simp
  apply (insert max_stack1 [where e=e])
  apply (rule OK_tyi'_in_statesI) apply (simp_all add: mxs)[3]
 apply (erule compT_states(1))
     apply assumption
    apply (simp_all add: mxs mxl)[4]
apply (rule conjI)
 apply (auto simp add: wt_start_def tyi'_def tyl_def list_all2_conv_all_nth
   nth_Cons mxl split: nat.split dest: less_antisym)[1]
apply (frule (1) TC2.compT_wt_instrs [of P _ _ _ _ "[]" "max_stack e" "length Ts + max_vars e" Tr])
   apply simp_all
apply (clarsimp simp: after_def)
apply hypsubst_thin
apply (rule conjI)
 apply (clarsimp simp: wt_instrs_def after_def mxl mxs)
apply clarsimp
apply (drule (1) less_antisym)
apply (clarsimp simp: wt_defs xcpt_app_pcs xcpt_eff_pcs tyi'_def)
done
(*>*)

end

definition compTP :: "J1_prog  tyP" where
  "compTP P C M = (
  let (D,b,Ts,T,e) = method P C M;
       E = case b of Static  Ts | NonStatic  Class C # Ts;
       A = case b of Static  {..<size Ts} | NonStatic  {..size Ts};
       mxl = (case b of Static  0 | NonStatic  1) + size Ts + max_vars e
  in  (TC0.tyi' mxl [] E A # TC1.compTa P mxl E A [] e))"

theorem wt_compP2:
  "wf_J1_prog P  wf_jvm_prog (compP2 P)"
(*<*)
  apply (simp add: wf_jvm_prog_def wf_jvm_prog_phi_def)
  apply(rule_tac x = "compTP P" in exI)
  apply (rule wf_prog_compPI)
   prefer 2 apply assumption
  apply (simp add: compTP_def) apply(rename_tac C M b Ts T m)
  apply(case_tac b)
― ‹ Static ›
  apply (clarsimp simp add: wf_mdecl_def)
  apply (rule TC2.compT_method_Static [simplified])
         apply (rule refl)
        apply (rule refl)
       apply assumption
      apply assumption
     apply assumption
    apply assumption
   apply (drule (1) sees_wf_mdecl)
   apply (simp add: wf_mdecl_def)
   apply (blast intro: sees_method_is_class)
  apply assumption
― ‹ NonStatic ›
  apply (clarsimp simp add: wf_mdecl_def)
  apply (rule TC2.compT_method_NonStatic [simplified])
         apply (rule refl)
        apply (rule refl)
      apply assumption
     apply assumption
    apply assumption
    apply assumption
   apply (drule (1) sees_wf_mdecl)
   apply (simp add: wf_mdecl_def)
   apply (blast intro: sees_method_is_class)
  apply assumption
  done
(*>*)

theorem wt_J2JVM:
  "wf_J_prog P  wf_jvm_prog (J2JVM P)"
(*<*)
apply(simp only:o_def J2JVM_def)
apply(blast intro:wt_compP2 compP1_pres_wf)
done

end

Theory JinjaDCI

theory JinjaDCI
imports
  "J/Equivalence"
  "J/Annotate"
  "JVM/JVMDefensive"
  "BV/BVExec"
  "BV/LBVJVM"
  "BV/BVNoTypeError"
  "Compiler/TypeComp"
begin

end